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Preface 



In the fall of 1952 I joined, as a graduate student, a Massachusetts Institute of Tech- 
nology project called the Geophysical Analysis Group, and so began a twelve-year 
effort in the application of digital computers to time-series problems. This project, 
the G.A.G., was organized by Professors G.P. Wadsworth and P.M. Hurley of 
M.I.T. and by Dr. Daniel Silverman of the Stanolind Oil and Gas Company. It 
assumed the task of attempting the realization of Norbert Wiener's time-series con- 
cepts on the Whirlwind I (WWI) Computer in the echo-sounding problems of seismic 
exploration for oil. 

At the same time I developed a close friendship with my fellow student Enders 
A. Robinson, on whom the directorship of G.A.G. soon devolved. Robinson's efforts 
centered in the elucidation of theory and its translation to discrete notation, and my 
own work tended toward machine realization of theory, but we each made sufficient 
excursions into the other's domain to form a profitable research partnership. This 
pattern has persisted over the years. 

The Geophysical Analysis Group is relevant for the reason that many of the pro- 
gramming concepts presented herein were seeded in the 16-bit registers of WWI for 
the seismic exploration problem. Digital prediction, both single and multiple, special 
digital filtering, spectral and correlation analysis, traveling spectral analysis, auto- 
matic processing systems for multirace seismograms, and many other operational 
concepts were developed and experimented with on WWI to an unprecedented degree. 
Besides myself and Robinson those involved with computation included Mark Smith, 
Howard Briscoe, William Walsh, Robert Bowman, Freeman Gilbert, Sven Treitel, 
Donald Grine, Kazi Haq, Donald Fink, Robert Wylie, Manuel Lopez-Linares, Richard 
Tooley, and Robert Sax. The ideas carried into industry and pursued there by stu- 
dents associated with G.A.G. have now ripened to the point of causing what amounts 
to a technological revolution in seismic interpretation. 

In 1954 Robinson left, eventually to become Associate Professor of Mathematics 
at the University of Wisconsin, and I assumed directorship of G.A.G. until its termi- 
nation in 1957, but frequent visits with each other kept alive our mutual interests. 

With G.A.G.'s termination and the subsequent retirement of WWI, I was forced 
to the realization that my programming output might just as well have been expressed 
in vanishing ink — an experience which rankled long and which underlies our determi- 
nation to develop stable programming and communicating techniques. 

I took a year's leave of absence from my Assistant Professorship in the Depart- 
ment of Geology and Geophysics at M.I.T. and spent it in military applications of 
special-design general purpose computers with RCA. This work tended to keep me 
from recognizing the latent power of the then infant language of FORTRAN. 
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On returning to M.I.T. I kept my hand in programming on the IBM 704, but it 
was not until 1960, when I was asked by the Advanced Research Projects Agency to 
set up a project like G.A.G. but focused on the underground detection problem of 
VELA UNIFORM, that I became seriously involved with the new computers. I was 
fortunate in being able to attract Robinson to the project, as well as many gifted grad- 
uate students. 

By this time FORTRAN had become well established, and, after some hesitancy, 
we began to use it, gradually evolving a sense of proportion in the mixture of 
FORTRAN and FAP programming. I find in this mixture that the whole is greater 
than the sum of its parts. For not only can we have the essential power of the indi- 
vidual languages, but they can supplement each other's weaknesses, as, for instance, 
they do when we use subroutine sandwiches of alternating language or use FAP pro- 
grams to bolster FORTRAN'S capabilities. 

Once again this leaves me committed, albeit partially, to a machine language. 
But the situation is not as bad as it was ten years ago. In the first place, the ubiquity 
of the IBM 700 series machines suggests a national and international investment in 
specific hardware and software of considerable inertia. The time constant of change 
has lengthened to a point where we should be able to keep up with it without periodic 
wholesale abandonment of past results. Secondly, our program design, testing, and 
documentation techniques have matured to the point where machine language transla- 
tion is not nearly as formidable a prospect as previously. 

These considerations, the rapid advances which have been made in time-series 
computations, the growing requests we have had for the programs, and the general 
expanding interest in time series and in programming, have all encouraged me to 
pause and to pull together the myriad threads of our work into a single document rep- 
resenting, in first approximation, where time-series computations stand with respect 
to today's machines. Such has been my goal. However, this goal has proved too 
ambitious for a single volume, and we content ourselves in Volume I with a presenta- 
tion of our subroutine library per se. Volume II will be devoted to the development 
of pertinent time-series theory from the computational viewpoint, to the considera- 
tion of computational applications in a realistic setting, and to discussion of pro- 
gramming technique. 

Taken together, the first and second volumes of Time-Series Computations in 
FORTRAN and FAP may be considered an introduction to a new topic, namely, the 
realization of modern time-series theory on digital computers. Their principal 
intended audience is students of time series or communications engineering who wish 
to acquire advanced techniques of handling empirical time series with present-day 
computational equipment, especially on the IBM 709, 7090, or 7094. By "advanced" 
I refer both to the conceptual level of the techniques and to the professionalism of 
their realization. 

But I would hope that this work, Volume I especially, should also prove of value 
to the general programming community. The majority of our programs are not 
specialized to the time-series area. What we have done is to fill the gap between 
basic FORTRAN statements and time-series operations with a complex of general- 
purpose black boxes that could be used to assist in the development of other areas of 
application. But even aside from functional utility, we hope that all computing groups 
faced with the problems of program exchange and communication will be interested in 
our experiments in communication formalisms. 

The subroutine library constitutes the bulk of Volume I. It represents the dis- 
tillation of years of effort of my co-workers and myself. Cost studies of program- 
ming systems of this size (about 40,000 registers) might predict a developmental 
price tag of about a quarter million dollars for this set. Consequently we have felt 
justified in devoting considerable time and effort to the development of techniques for 
communicating our results in the context of applied problems. 
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At the lowest level of communication, that is, the individual subroutine, we 
have tried to maintain high standards both of programming and of documentation. 
Toward the latter end, we have adhered to a program -writing format which might be 
called the self-documenting symbolic deck. In this format, the program card deck 
contains a program abstract and a detailed input-output specification, as well as illus- 
trative and critical examples. The card deck is totally definitive of its own behavior. 

The format was originally designed for input to an automatic debugging compiler 
which would read the examples, set up appropriate test programs, execute the test 
programs, and report back results. In the press of other business the compiler never 
proceeded beyond a rudimentary stage, but the format has remained and proved itself 
valuable in our own internal communications. 

Furthermore, the format has proved itself many times over as a disciplining 
device for keeping programmers honest. It is a characteristic of the trade that pro- 
grammers modify and remodify their decks. The juxtaposition of the documentation 
and the program proper in deck listings emphasizes documentation errors that result 
from such modifications, and the weeding out of these errors becomes a natural and 
integral part of the debugging process. Moreover, to a programmer, there is a great 
psychological difference between having to change a few comment cards and tracking 
down a secretary to make the same changes on a mimeograph master in order to run 
off an updated memorandum. 

The self-documenting program deck is a black box with input-output terminals 
fully described. It is necessarily bulky, the description being generally several times 
the length of the program proper. For routine reference we turn to compressed sum- 
maries, the "program digests," which, by judicious choice of terminology, enable one 
familiar with the programs to refresh his memory of calling-sequence details needed 
while programming, with an absolute minimum of page turning. For general scanning 
of and access to the programs, we have sorted them by various functional and non- 
functional attributes. The other types of documentation in Volume I relate to sub- 
routine library structure and are of more specialized interest to the system 
programmer. 

But the study of n black boxes, each of which performs an isolated task in time- 
series analysis, does not give one a sense of the coherency of the subject, or of the 
methods of interconnecting the boxes in broad experimental applications. For such 
purposes we have designed the experimental programs to be presented in Volume II. 
Each of these programs represents a series of experimental studies in an inter- 
connected area of time-series analysis, with some carry-over from one program to 
the next. They permit the reader to see essentially all of our subroutines used in 
an applied framework. 

The applications chosen for illustration in Volume II range from elementary 
ones to problems the average student or research worker is unlikely to have 
encountered (especially multi-input processes). Since our theoretical development of 
time series is of rather limited scope, we have included appendixes on some of the 
less well-known topics covered in the experiments. 

The experiments of Volume II are designed to be readable without knowledge of 
the basic machine language, FAP, and to require a minimum of experience with 
FORTRAN. The study of Volume II, especially in conjunction with practice on a com- 
puter which can accept the subprograms of Volume I, is probably the easiest way of 
acquiring familiarity with the techniques we have to offer. 

It is an unfortunate fact that artificial but general languages like FORTRAN are, 
in themselves, incapable of expressing many of the' critical time-series operations in 
truly efficient form. This situation may change, but probably not in the near future. 
To a large extent dur subroutine library may be viewed as an interdependent collection 
of FORTRAN and FAP programs where the FORTRAN programs steer the FAP pro- 
grams to the desired task. The higher-level FORTRAN programs will easily compile 
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on machines outside the IBM 700 series family, but their required subordinates, the 
FAP workhorse programs, will not in general carry over without hand-coded 
translation. 

For this reason, Volume II will present expositions of the more important logi- 
cal processes used in the FAP subprograms to attain high-speed behavior, particularly 
in connection with correlation and spectral analysis. A knowledge of FAP is desirable 
but is not essential, since we lean considerably on ordinary flow charts for detailed 
relationships. 

Other limitations of a formal nature inherent in FORTRAN II have led us to some 
programming effort in the twilight region between FORTRAN and FAP, that is, to the 
writing of FAP programs which utilize "forbidden" knowledge of the FORTRAN system 
in order to remove these limitations, and which we therefore label "system-expansion 
programs." Volume II includes a discussion of the techniques and problems involved 
in such programming and should prove of interest to serious students of programming. 

In short, then, we have limited the first volume to the presentation of the sub- 
routine library with subsidiary documentation designed for the working programmer, 
and we have reserved time-series and programming concepts for Volume II. 

The "we" I use frequently above is not editorial, but includes my many co- 
workers, mostly graduate students, who have contributed to the subprogram collection 
and with whom it has been my pleasure to work. In this congenial and loosely struc- 
tured group, considerations of programming technique and style were developed to 
refined levels. Although the authorship of the programs is given individually, I would 
like to emphasize the importance of the contributions of James Galbraith, Jon Claerbout, 
and most particularly Ralph Wiggins. Other students directly associated were William 
Ross, Cheh Pan, Carl Wunsch, and Roy Greenfield. 

As for what theory we include in Volume II, much of it is pure review, but some 
of it has previously appeared only in project report form. I consider Robinson's 
solution, in the fall of 1962, of the multi-input iteration problem to be a significant 
achievement. Wiggins pursued and expanded the analysis from this base through the 
program-development stage, and in so doing was the first to demonstrate the compu- 
tational feasibility of multi-input least squares. 

But the work presented here has also depended on many others. The tireless 
and dedicated writing of test routines by Joseph Procito has been invaluable in the 
establishment of program reliability. In broader areas of service programming, 
analysis, data handling, desk calculating, etc., we also relied on Mrs. Irene Hawkins, 
Karl Gentili, my wife Jacqueline, Ervinia Irbin, Mrs. Susan Kannenberg, Allan 
Kessler, and Lloyd Kannenberg. Most of the card preparation and manuscript chores 
fell to Mrs. Elizabeth Studer, to my wife, and to Mrs. Wendy Tibbets, with assist- 
ance from Mrs. Elene Hershberg, Dauna Trop, Mrs. Myrna Kasser, Regina Lahteine, 
Mrs. Hazel White, and Mrs. Barbara Cullum. 

The punched-card work involved in these two volumes is too elegant to be passed 
over without further comment. The conventions and forms that we now use regularly 
(not all of which appear in these volumes; for instance, the mathematics of Volume II 
was card-coded in the source manuscript) I consider to be significant experiments in 
a field — call it "punched-card typography" — of growing importance in printing. In 
large part these conventions are due to my wife, who has become our arbiter of formats 
and to whose sense of style and standards of excellence we are much indebted. 

Over the years we have been favored with the most friendly cooperation of the 
machine operators and supervisors, starting in the early Whirlwind days with Robert 
A.J. Gildea (to whom I also owe many enjoyable hours of chess while waiting for the 
machine to come back) and Michael Solomita, and continuing with Anthony Sacco at 
the M.I.T. Computation Center and at the Cooperative Computing Laboratory at M.I.T., 
John Harmon and our long-term friend Michael Saxton of IBM, and more recently with 
Thomas Burhoe, Mason Fleming, and William Jarvis of IBM. 
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We owe much to the sponsors of both the G.A.G. project and the VELA UNIFORM 
project for the computing facilities these projects have afforded us in the development 
of time-series and computing concepts, and to Lincoln Laboratory, the M.I. T. Com- 
putation Center, and Geoscience Incorporated for the use of programs developed 
under their auspices. 

Concerning editorial assistance, I am indebted to Robinson for critical review 
of the mathematical aspects of the manuscript and to Wiggins for his joint labors with 
my wife and myself in the editing of the programs. 

It is indeed a pleasure for me to acknowledge the many contributions and 
accommodations from this small army of co-workers and associates. 

Brookline , Massachusetts S. M. S. , Jr. 

November, 1965 
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Introduction 



The heart of this book is the presentation, in Section 10, of 267 programs which are 
rather widely applicable even though their development was motivated by problems in 
the field of time-series analysis. The reader may turn to any one of these programs 
and study it with understanding without a need for the material in the preceding sec- 
tions, these sections being concerned with introductory and access information, and 
with tabulation of data abstracted from the programs. In particular, the present 
section is concerned with an overview of the programs as a set, and with general con- 
siderations of language, terminology, and programming philosophy. 

The use of this book and of the programs presupposes some familiarity with the 
artificial computing language FORTRAN and, but to a lesser and nonessential extent 
with the machine language FAP. A reader with only FORTRAN background should be 
able to read through all of the textual material of the introductory sections in one sit- 
ting and lose very little from our occasional references to machine-language details. 
Thereafter he should have no trouble in locating programs of interest by means of the 
categorized lists of Section 3, or in utilizing, with the aid of Sections 4 and 5, the pro- 
grams he has become familiar with. However, in his reading of the programs in 
Section 10, a person of this background will generally be limited to the FORTRAN 
programs, although if he has sufficient curiosity he will find that many of the machine- 
language programs are quite easy to follow with the aid of a machine manual (95 of 
these programs involve less than 50 machine-language instructions and constants, 31 
less than 25). 

Many of the tabulations to follow contain data on program storage lengths and 
binary card counts; these data are somewhat dependent on the particular system used 
to translate the symbolic decks into machine language. The statistics given pertain to 
FORTRAN II, Verson 2, IBM Modifications 1 through 27, further modified to accept 
the G format.* 



*In reference to the monitor system, one might note that we have found it useful to 
modify the BSS loader to extend its limit on the maximum number of missing subrou- 
tines from 50 to 200. (This is accomplished by reassembling records 7, 8, and 9 of 
the FORTRAN Monitor System after appropriately redefining the symbol NMMSP.) 
Without this change large main programs referring to many library subroutines occa- 
sionally have their executions blocked. An alternative, if ad hoc , solution to this 
problem is to reduce the missing subroutines count by adding a number of the required 
routines to the input deck when the problem arises, rather than by obtaining them from 
the library. 
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GENERAL ASPECTS OF THE PROGRAM SET 

To begin our general view of the program set we will comment briefly on the variety 
of functions performed. Examination of the categories of Section 3 will show a wide 
diversity in the computational topics embodied, these topics ranging from spectral 
analysis and discrete filtering (convolution) to matrix manipulation, to polynomial 
operations, to machine graphing, to technical matters of program administration, and 
to a number of other topics. Conversely there are some programs which essentially 
or actually duplicate the functions of others. There are several reasons for such 
redundancy. Sometimes the reason is to provide both FORTRAN and FAP versions, 
and sometimes it is to illustrate alternative programming techniques, but more often 
the reason is historical accident. The redundancies are preserved in our use because 
of references made in main programs not shown, and occasionally because of differ- 
ences in taste, but other groups might find it profitable to trim down the collection. 
The tables of Sections 8 and 9 are useful for checking the consequences of contemplated 
program deletions. 

Similarly, one will find considerable diversity both in program size, as meas- 
ured by storage requirements* which vary from 1 register to 1499 registers with an 
average of 152, and in complexity, as measured by calling-sequence lengths, which 
vary from 0 to 22 with an average length of 4.5; by number of entry points, which 
varies from 1 to 18 around a mean of 1.5; and by the required number of pages of 
descriptive documentation, which ranges from 0.5 to 16 with an average of 1.4. 

Necessarily we must also admit to some diversity in the technical quality (not in 
accuracy or utility) of the programs. In general, the quality will have a positive cor- 
relation with the date of the writing. Such quality problems as may exist are most 
often due to awkwardness of design or of expression, resulting in programs larger 
than necessary. However, the critical program loops are usually very efficient despite 
these factors. 

Of the 267 programs, 90 are written in FORTRAN language, which is acceptable 
to most computers, and 177 are written in the FAP (FORTRAN Assembly Program) 
language, which is applicable only to the IBM 709, 7090, and 7094 computers.** The 
average length of the FAP programs (85 registers) is distinctly smaller than that of 
the FORTRAN programs (283 registers). All of the programs are subroutines in the 
general FORTRAN sense of the word. The FAP subroutines conform to the subroutine 
linkage requirements of FORTRAN II and consequently can be used by FORTRAN pro- 
grammers who are unfamiliar with the FAP language. 

It must not be assumed, however, that the 90 FORTRAN programs can be used 
immediately on computers other than the 709 series machines, or that they may be 
operated under FORTRAN IV. For the program library is strongly interconnected, 
and although each program is usable by the programmer as an apparently independent 
entity, many of them internally require the services of up to 16 other programs from 
the library. It turns out that only 23t of the FORTRAN programs either need no other 
programs from the library, or, if they do, need only programs which are themselves 
FORTRAN. Thus the library in present form is by and large specialized to operations 
under the FORTRAN II Monitor System of the IBM 709, 7090, or 7094. 

The program changes needed to permit operation under FORTRAN IV on the 
IBM 709 series machines are minor compared to those necessitated by a change of 
computers, but are still more extensive than a specialist in such matters might guess 
from what has been said so far. The standard changes with regard to transfer of 



*The numbers here are exclusive of lower-order programs that might be required. 
Including these, the range is 1 to 5106. 

**Thirteen of the programs will work only on one or two of these three machines, 
t Some of these 23 programs require the use of FORTRAN system routines. 
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control, to the direction of storage of subscripted arrays, and to the binary point of 
fixed-point numbers must be made for all FAP programs needed. But about 30 of the 
FAP programs depend on more than routine knowledge of FORTRAN II (some scan the 
calling program ahead of or behind the calling sequence, some have variable-length 
calling sequences, some refer to non-FORTRAN-callable system routines, and some 
utilize data left behind by the monitor). These programs require additional and more 
involved changes. Offsetting this complication, however, is the fact that a number of 
these unorthodox programs have the function of expanding the capabilities of FOR- 
TRAN II in ways now included as built-in features of FORTRAN IV, and conse- 
quently this number can be dropped entirely, providing suitable changes are made in 
programs referring to them. On the other hand, there will be cases where the possi- 
bility exists of choice between FORTRAN II and FORTRAN IV, and here one should 
balance the advantages of FORTRAN IV over FORTRAN II as bolstered by our system- 
expansion programs against the required changes in the particular programs needed. 

In this volume, little direct help is provided for the problem of translation of 
the FAP programs for use on other machines. As a practical matter, however, it 
should be pointed out that many, perhaps most, of the FAP programs are of such 
elementary nature that their functional description and examples as given in Section 10 
are all that coders for other machines will want. (They are more likely to consider 
many of the programs to be beneath their dignity.) The more involved FAP programs 
may require the services of an experienced translator. The second volume of this 
work will give numerical analysis discussions and flow charts of value in these cases. 

The programs of Section 10 are alphabetically ordered by program name where 
the name of a program is, under ordinary circumstances, taken to be identical to the 
name of the entry point. For FAP programs with multiple entries the program name 
is taken from the first entry card in the deck. However, the alphabetized page head- 
ings of Section 10 do include all principal and secondary entries, in the latter case 
merely giving a reference to the associated principal entry. If the program will 
operate only on the 709, we append (709) to the name; if it will not work on the 709, 
(7090) is appended; and if it works only on the 7094, (7094) is appended. (None of the 
programs work only on the the 7090.) There are some programs of identical entry name 
(they always perform identical or practically identical functions), and these are distin- 
guished by appending the serialization —II or —III. 

TERMINOLOGY BACKGROUNDS 

In the foregoing review we have been using a number of undefined terms, such as 
"program, " ' 6 subroutine/ ' "compiler," and "entry point," on theassumption that the 
reader is more or less familiar with them, at least in FORTRAN usage. We now 
would like to clarify usage for some of these terms. Unfortunately the attempt to 
capture their general meaning with precision leads one into more extensive discussions 
of topics concerning computer hardware and input-output devices than we wish to 
engage in, and we shall be satisfied with some of the salient definitional features of 
the broadest of these terms, namely "computer program/ ' 

As a trial definition, let us take the term computer program t o mean in general, 
"the representation of a plan of activities which could be carried out by a computer, 
where the activities possess a logical completeness and integrity with respect to some 
motivating function." The program user is interested, in the first instance, in the 
nature of the motivating function and in those aspects of the plan which enable him to 
understand the program assumptions, or inputs, and the program results, or outputs. 
The technical substance of the term, however, is contained more in the natures of the 
"representation" and of the "plan," and in the interpretation of the phrase "could be 
carried out by a computer" than it is in the utilitarian aspect of the program. 



3 



Time-Series Computations in FORTRAN and FAP 



The problems of meaning here, which are just beginning to be of concern in 
questions of law, are severe now and are likely to become worse with time. For the 
massive efforts going on in compiler development are continually expanding and dif- 
fusing the boundaries of meaning. To give an example, what is now commonly called a 
"FORTRAN program' ' could hardly have qualified as a computer program had it ap- 
peared back in 1950 (it would have been referred to probably as a form of algorithm), 
not because of the absence of a suitable computer but because there was no compiler 
at that time to give operational meaning to a FORTRAN program. At the present time 
it is easy to conceive of a compiler which will accept, say, building blueprints and 
generate programs to produce complete purchasing lists, construction schedules, etc. 
Is a blueprint then to be considered a computer program? Let us set this question 
aside for a moment. 

What is happening is that compilers and input-output devices are being taught how 
to read and respond not only to specification languages , that is, representations of 
plans of activities especially invented for computers, but also to many such languages 
established prior to the development of modern computers. This educational process 
drives the perimeter of meaning for the term i 6 computer program' ' outward so as to 
overlap accepted usage in older disciplines in which people are now seeking to tap the 
potential of the big machines. 

These remarks point up a logical complication in our trial definition of the term 
"computer program,' ' namely that this definition is clearly dependent on the meaning 
of the as yet undefined term * ' compiler," for a compiler , which may be classified 
briefly as a program-to-program translator, is itself a computer program. The defi- 
nitional circle involved here can be broken by re sorting to a recursive form of definition 
which uses the concept of a "machine-language program" to provide a semantic link 
to hardware. 

Strictly speaking, we can define a machine -language program to be a representa- 
tion of a plan of activities for a given computer , which is fully detailed in that it 
explicitly and individually specifies the desired initial physical state of every memory 
element in the computer which will participate in the activities. Thus for a binary 
computer the machine-language program might be a punched paper tape, where each 
potential punch position on the tape is equated by correspondence assumptions with an 
individual binary memory element. (Note , however, that an octal shorthand of the 
binary expressions on tape would not be a machine-language program in the strict 
sense, since such specification, while explicit, is not individual.) A loader (whose 
generalizations are "assemblers" or "compilers") is then a device or procedure aware 
of the correspondence assumptions and capable of forcing the physical states of the 
memory elements in question to correspond to the specifications of any given machine- 
language program. 

The present usage of the term computer program is, then, more closely approx- 
imated by a "representation of a plan of computational activities which is either a 
machine-language program or else can be translated into a machine-language program 
by a computer responding to another machine-language program or by a succession of 
such translations." Thus one or more computers may be involved in the translation, 
and none of these is necessarily the same as the computer on which the original pro- 
gram is eventually executed. The translation programs are called assemblers or 
compilers . 

It is useful to widen the meaning of "machine-language program" to include all 
programs written in a machine -dependent language under which the programmer has 
unrestricted and easy access to every capability of the machine. The term absolute 
machine-language program can be used to refer to the stricter usage when necessary. 
The more general machine language is essentially a symbolic shorthand notation for 
the absolute machine language. An assembler is then a translation program for 
machine-language programs in the wide sense. 
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Our redefinition of computer programs evidently supports the affirmative position 
on the question raised earlier concerning blueprints, that is, Should blueprints be con- 
sidered as computer programs once the compilers can handle them? Nevertheless a 
strong negative position can be developed. It stems from a critical analysis of what 
constitutes a "plan of activities for a computer/' 

The basic activity of a computer is computation, or calculation on numbers. The 
numbers calculated on are usually physically disjointed from the commands of calcula- 
tion and are gathered in an area labeled data , while the commands are gathered in an 
area generally accepted as program. (Note that the FORTRAN language is designed in a 
way which formalizes this division and heightens the impression of absolute distinction 
between program and data.) Moreover, the numbers are frequently prepared on, say, 
a card deck and read into the data area by program commands prior to calculation. 
Such a card deck is not considered a program in any sense of the word. 

But if the basic activity of a computer is calculation on numbers, the essential 
defining activity which distinguishes a computer from an overgrown desk calculator 
is calculation on the program itself. The proper understanding of this feature, abor- 
tively introduced by the precocious Babbage over a century ago, is often the most con- 
fusing obstacle a programmer must master in the study of his first machine. The 
confusion is due to the possibility, in fact the necessity, of the occurrences of am- 
biguity between program and data.* It is the transposition of this ambiguity to the 
level of compilers which makes our hypothetical question of blueprint classification 
truly a moot one. 

Thus the card decks which are processed by programs may contain information 
other than numbers for calculation. In particular they may contain numbers and sym- 
bols which indicate to the program the user's desired specializations, selections, or 
sequencing among alternative computational capabilities built into the program. Such 
decks are no longer thought of as data decks but rather as control decks. The plan of 
activities begins to migrate from the program proper to the cards. In the limit the 
cards themselves can become a new program in their own right, and the processing 
program becomes a compiler. 

When can one say that this limit has been reached? A useful measure to apply 
is the range of controls one can exercise with the card deck. If this range covers all 
or most of the actual machine capabilities,** as it does in FORTRAN, then the control 
deck may clearly be classed as a computer program. As this range narrows, the plan 
of activities must be said to reside more and more in the program which processes 
the cards. 

A blueprint must be considered to be analogous to the control cards of the 
foregoing discussion. Clearly the range of controls possible is highly restrictive; 
there would probably be no way, except perhaps a highly artificial one, to request, for 
example, the sum of one hundred numbers. The true plan of activities for the computer 
is a combination of the blueprint and the compiler. In the light of the present discus- 
sion, the blueprint may be viewed as control information for this plan, or even as a 
plan of activities for the compiler, but not in itself as a true computer program. 



*For an illustration in the present program set see subroutine PROCOR. PROCOR 
produces a computer program in response to an arbitrary array of numbers and may 
therefore be thought of as a specialized assembler whose input "program" is the 
number array. 

**We are speaking through this discussion of 4 'general purpose" digital computers, 
which we leave as an undefined concept. At present most of the major computers are 
sufficiently similar in respect to capability that each one can simulate the behavior of 
any of the others, as well as that of the prototype "Turing machine.' ' 
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USAGES IN THE PRESENT VOLUME 

For present purposes a ' i computer program" is a card deck (or any of its translations 
or transmissions produced by compilation, assembly, listing, card-to-tape loading, 
etc.) prepared according to the rules of FORTRAN II programming or of FAP pro- 
gramming for the 709, 7090, or 7094. Since these fully documented rules prescribe 
well-defined program entities, ticklish questions of shades of meaning do not arise. 
Nevertheless it is of some value to review here some highlights of subroutine notation, 
since all of our programs are of this type, as well as to discuss a few notational con- 
ventions of our own. 

The expression computer routine is usually used to describe a program whose 
functional motivation, while possibly complete in itself, is somehow subsidiary to the 
principal computational thought under consideration. The " routine" mayor may not be 
merely a segment embedded in a larger program. In any event, compiling and assem- 
bly systems provide formal rules by which principal and subsidiary computational 
thoughts may be linked with respect to program flow and information exchange, and 
routines written under these rules are known generically as subroutines . But there 
are exceptions and inconsistencies in usage. Thus in FORTRAN manuals the word 
"subprogram" tends to vie with ' 'subroutine" for the generic title, since we see refer- 
ences both to ' ' subprogram-type subroutines" and to " subroutine-type subprograms." 
This terminology problem, though not of great practical concern, is necessarily 
present in this volume since all the programs here are written so as to be FORTRAN- 
compatible. The ambiguity is relieved somewhat by adopting the following positions. 

(1) "Subroutine" can refer either to the general class of subsidiary computations linked 
by formal rules to a larger computational scheme, or it may refer to a particular 
form of such linkage, the reference being apparent from context. 

(2) When "subroutine" refers to a particular form, then it must refer to the function- 
ally most general such form within the given class of forms. 

Thus the specific form known in FORTRAN as the subroutine or (subroutine- 
type) subprogram may be considered most general in that its inputs and outputs are 
unrestricted in form, whereas the other subprogram types, known as functions , are 
restricted to having scalar-valued outputs and in some case inputs.* 

From the practical point of view, however, our problem is merely to review 
the rules which distinguish among the three kinds of FORTRAN-style subroutines that 
appear in this book. The first of these is the ordinary subroutine subprogram, which 
is defined by the appearance at the beginning of the FORTRAN deck of a statement of 
the illustrative form** 

SUBROUTINE SUB(A,B, . . . ,D) 

where SUB refers to one to six alphanumeric characters starting alphabetically, but 
terminating with F only if less than four characters are involved, and where A,B,. . .,D 



*Unfortunately even here we would have to yield to the technical argument that a 
FORTRAN function may have general outputs in addition to its scalar output (the func- 
tion value), on which basis the FORTRAN function could be claimed as the most 
general subroutine type, although the design intent and description seem to center on 
the scalar output. 

**One or more RETURN statements are usually included but are not mandatory. Simi- 
larly, in our FORTRAN Monitor System (FMS), the subroutine need not refer to all or 
even any of the names of its arguments. 



6 



Introduction 

is a list of nonsubscripted names, all different from SUB, which are the arguments of 
the subroutine (the list may be void, in which case the parentheses are suppressed), 
the names being those of variables or of other subroutine subprograms or FORTRAN 
functions. 

This type of subroutine is referred to from another FORTRAN program by a 
statement such as 

CALL SUB(E,F,. . . ,H) 

where E,F, . . . ,H is a list of arguments each of which (1) would form a legal right- 
hand side to a non-Boolean arithmetic statement, or (2) would form a legal alpha- 
numeric field in a format, or (3) is a name appearing on an F card in the calling 
program. 

The arguments E,F, . . . ,H should match A,B, . . . ,D in mode (e.g., fixed point 
or floating point) and number. Moreover there must be understanding between the 
calling program and the subroutine concerning each argument which is a subscripted 
array. This is most easily achieved by making corresponding DIMENSION statements 
(identical except possibly for the variable name) in the two programs. But the 
DIMENSION statements do not necessarily have to agree, even with respect to number 
of subscripts (the same holds for variables equated by EQUIVALENCE statements). 
What is necessary is that the two programs reach an agreement based on the following 
rules governing the absolute machine location of a subscripted quantity: 

LOC(A(I)) = LOC(A(l)) - (1-1) 

LOC(B(I,J)) = LOC(B(l,l)) - (1-1) - (J-l)* IDIMEN 
LOC(C(I,J,K)) = LOC(C(l,l,l)) - (1-1) - (J-l)* IDIMEN 

- (K-1)*JDIMEN*IDIMEN 

where LOC() symbolizes 4 'absolute machine address of," and where we are assuming 
a DIMENSION statement of the form 

DIMENSION A(IDIMEN),B (IDIMEN, JDIMEN), C (IDIMEN, JDIMEN,KDIMEN) 

Note that the first equation above does not involve a dimension. Consequently 
it is frequently useful to have the subroutine first dimension all of its arrays as singly 
subscripted quantities (with dummy values of the dimension) and then access the 
elements using the above relations plus values of the dimensions given to it in the 
calling sequence. For example, if the calling program has 

DIMENSION C (10,20, 3) 

ID = 10 
JD = 20 

CALL SUB(C,ID,JD,...) 

and the subroutine has 

SUBROUTINE SUB (A,IDIM EN, JDIMEN, . . . ) 
DIMENSION A(l) 
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then the subroutine can acquire, for example, C(5,15,2) by the statements 

L = 5 + 14*IDIMEN + JDIMEN*IDIMEN 
X= A(L) 

By using this type of scheme (not required in FORTRAN IV) , it becomes unnec- 
essary to recompile the subroutine for each calling program having different DIMEN- 
SION statements. We use it very frequently in the programs of Section 10. 

The translation to FAP of the statement 

CALL SUB(E,F,. . . ,H) 

is symbolically 

TSX $SUB,4 
TSX E,0 
TSX F,0 

TSX H,0 

where $SUB is a reference to the transfer list discussed below, and where E,F, . . . ,H 
now stand for machine locations containing the corresponding arguments. For each 
argument which is an array in the calling program but which appears in the CALL 
statement with no subscripts, the location is assigned as though it had appeared with 
all of its subscripts set to value one. 

The FORTRAN function (of which there are only two in the present set) is defined 
by the appearance at the beginning of the FORTRAN deck of something like 

FUNCTION FNCTN(A,B, . . . ,D) 

and must include a RETURN statement preceded by an arithmetic statement of the form 

FNCTN = 

where FNCTN obeys the same naming rules as SUB above, and where A,B, . . . ,D is 
similar to the same expression in the subroutine-subprogram case but must not be a 
void list. 

The FORTRAN function is referred to from another program by an arithmetic 
statement such as 

X = . . . FNCTN(E,F, . . . ,D) . . . 

where the right-hand side of the equality is any legal FORTRAN expression which 
treats FNCTN(. . .) as a single number. The mode of this number is assumed deter- 
mined by the function name according to FORTRAN naming conventions for variables 
E,F, . . . ,H and A,B, . . . ,D must match each other in the same manner as discussed 
above. The translation to FAP is the same as that of a subroutine subprogram, with 
$FNCTN, 4 replacing $SUB, 4, except that the statements immediately following the 
TSX H,0 will assume the value of the function, i.e., the single number generated by 
the function, to be in the accumulator. 
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The third type of subroutine is the closed (or library) function, of which there 
are many examples in Section 10. This type must be hand coded with a structure 
such as 

ENTRY FNCTN 



FNCTN STO A 



CLA VALUE 
TRA 1,4 

The reference to the closed function from a FORTRAN program is the same as a 
reference to a FORTRAN function, except for the following differences: F* is appended 
to the name, the function value is considered fixed-point if and only if the name of the 
function begins with X, and the arguments in the string E,F, . . . ,H may not be alpha- 
numeric fields or names of subroutines. The information linkage is quite different 
and less uniform, however. The four statements in the table below, with their effective 
translations, illustrate the information linkage adequately. 



X = 


FNCTNF(A) 


X = 


FNCTNF(A,B) 


CLA 


A 


LDQ 


B 




TSX 


$FNCTN,4 


CLA 


A 




STO 


X 


TSX 


$FNCTN,4 






STO 


X 




X = 


FNCTNF(A,B,C) 


X = 


FNCTNF (A,B,C,D,E) 


CLA 


C 


CLA 


E 




STO 


32765 (DECIMAL) 


STO 


32763 


(DECIMAL) 


LDQ 


B 


CLA 


D 




CLA 


A 


STO 


32764 


(DECIMAL) 


TSX 


$FNCTN,4 


CLA 


C 




STO 


X 


STO 


32765 


(DECIMAL) 






LDQ 


B 








CLA 


A 








TSX 


$FNCTN,4 






STO 


X 





In addition to closed functions, it is of course also possible to hand-code subrou- 
tines and FORTRAN functions. The formal structure is similar to that for the closed 
function. Two examples are 

ENTRY SUB ENTRY FNCTN 



SUB , FNCTN . 

CLA VALUE 

TRA N + 1,4 TRA N+1,4 



*In the tabulations of this volume the terminal F is not considered to be part of the 
proper name of the function. 
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where N is the argument count of the pertinent statement in the calling program, and 
where the hand coding is done subject to the argument transmission conventions 
illustrated earlier. 

In the listings of Section 10 the expressions FORTRAN subroutine and FAP 
subroutine under the ' 'language' ' heading always refer to the subroutine subprogram, 
and the expression FAP function to closed functions* The two FORTRAN functions 
are so labeled. 

Hand coding of subroutines, unlike FORTRAN coding, permits the bunching of 
many subroutines in one program deck (which is of ten useful if the subroutines perform 
similar operations). Thus 

ENTRY SUB1 

ENTRY SUB 2 

ENTRY FNCTN1 

ENTRY FNCTN2 

SUB1 



SUB 2 



TRA 5,4 
FNCTN1 STO A 
STQ B 



CLA VALUE1 
TRA 1,4 



FNCTN2 



CLA VALUE2 
TRA 6,4 

might be a " single" program representing two subroutine subprograms, each of which 
has four arguments, one closed function of two arguments, and one FORTRAN function 
of five arguments, all four subroutines needing access to the same table of numbers. 

This type of multiple-entry coding in FAP, appearing frequently in the library 
of Section 10, clouds the meaning of the term ' 'program.' ' From the standpoint of the 
calling program, each entry of a multiple-entry program is used as an independent 
subroutine; the calling program has no way of knowing that they are dependent. If a 
reference is made to just one of them, the loading program must nevertheless bring 
the entire bunch into the memory as a unit, since the physical deck cannot be divided. 
For example, the standard FORTRAN functions COS and SIN are separate entries to 
a single program and are always together in the machine if one of them is. 

We might speak of logical programs and physical programs to clarify intention 
when necessary. For program-writing purposes, however, there is never any neces- 
sity to refer to other than logical programs. In any case, it has become customary in 
many circumstances to bypass the question by simply referring to entries or entry 
points . This terminology relates to the fundamental topic concerning ' 'program" in the 
conception of the control hardware, namely, where to send control for the next job, 
and is neutral with respect to higher-level distinctions made by compilers. (Note that 
in the printed output of the compilation of a FORTRAN program one finds a list of 
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required logical programs accurately entitled " entry points to subroutines not output 
from the library.") 

For purposes of dealing with program decks and of general documentation, on the 
other hand, one must refer to a multiple-entried program as a unit. The manner of 
doing this is a matter of local convention. We have chosen to equate the name of each 
physical program with the name on its first entry card and to speak of that name as 
the principal entry , other entries being termed secondary entries. 

When FORTRAN or FAP is processing a program, it forms a complete nonre- 
dundant list of all of the entry names referred to by the program. This list, which 
appears in BCD form in the first registers of the absolute relocatable binary deck 
produced by the translation, is called a transfer list or, as it is called more often in 
this book, a transfer vector . Each reference to a subroutine in the program body, 
that is, each TSX $SUB, 4, becomes TSX A,4 where A is the register in the transfer 
list containing the name SUB. At execution time, the monitor system replaces the 
list of entry names with a corresponding list of Trap Transfer instructions whose 
address fields are the absolute machine locations assigned to the corresponding entries 
by the storage allocation logic for the particular execution. This scheme of routing 
all references to other entries through a single transfer vector helps minimize the 
relocation task of the loader. 

Transfer vectors often contain entries whose names are illegal subroutine names 
(containing special characters) from the standpoint of usage by FORTRAN programs. 
These routines, requested by the compiler as needed to implement associated FOR- 
TRAN statements, are called non-FORTRAN-callable routines. They can be directly 
referred to, however, from FAP programs, and the reader will find a number of 
such references in our program set. 

The program descriptions in Section 10 also use a more specialized notation; 
features of it are described in the following paragraphs. 

A FORTRAN INTEGER, or FORTRAN-II INTEGER, or INTEGER is a fixed-point 
quantity with binary point assumed between bits 17 and 18, with bits 18 through 35 all 
zero, where the 36 bits are labeled S,l,2, . . . ,35. 

A MACHINE-LANGUAGE INTEGER, abbreviated as MLI, has its binary point 
to the right of bit 35. 

A triple-dot notation is often used to suppress symbolic subscripts in expressing 
lists of numbers. Thus 

X(l . . . 3) stands for (X(I), I = 1,3) 

and 

Y(l . . .3,1 . . .2 \ 

or \ stands for ((Y(I,J),I = 1,3), J = 1,2) 

Y(l,2,3„l,2) ) 

The term VECTOR is used very commonly to refer to any singly subscripted 
FORTRAN variable, and its length is the highest subscript value of pertinence. A 
doubly subscripted variable is referred to as a MATRIX or 2-DIMENSIONAL ARRAY, 
and a triply subscripted variable as either a 3 -DIM ENSION AL ARRAY or a MATRIX 
VECTOR, this last term implying that the first two subscripts define a two-dimensional 
array which, in the context of the computation, obeys laws of matrix algebra. 

The abbreviations LSTHN, LSTHN = , GRTHN, and GRTHN = stand for the sym- 
bols < , < , > , and > respectively. 

Mathematical expressions appearing under ABSTRACT may deviate from 
FORTRAN conventions of naming and indexing. The emphasis here has been to pro- 
duce expressions which are visually close to those of ordinary mathematics. 
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The numerical examples given involve some notation which should be fairly 
obvious. Fixed-point number lists should always be assumed to be FORTRAN-II 
integers unless preceded by OCT for octal or MLI for machine language integer. On 
the other hand, the representation of Hollerith data is not too satisfactory or consis- 
tent as given here. In most cases we use either 

X(l . . . ) = 6H (something) 

or 

X(l . . . ) = 6H something 

to imply that the 6 ' something' ' is a string of Hollerith characters stored six to a regis- 
ter, that is, FORMAT(A6). However, in some cases the "something" maybe split 
into groups of six characters separated by commas to conform to the representation 
of ordinary numerical lists. In deciding which is meant, the reader will have to use his 
judgment from the context. 

There are some further notational discussions, which can be found in the intro- 
ductions to Sections 4 and 10, and there is a pronunciation guide to the entry-point 
acronyms in Section 6. 



PROGRAMMING PHILOSOPHY 

The program set of Section 10 grew over a considerable period of time in a program- 
ming environment which possessed continuity of personnel and computers, coherency 
of computational purpose, total rapport between analysis and programming, relative 
freedom from a crisis atmosphere, and adequate financial support — an uncommon 
and fortuitous environment indeed, and one in which programming philosophy could be 
developed and realized. To a large extent the programs themselves are an adequate 
expression of such developments. This is particularly true of documentation and 
testing procedures, which are discussed in Section 10 as well as in the Preface, but 
more general design considerations may not be as self-evident. 

Our most general explicit design tendencies have been to avoid writing 6 'main" 
programs except when absolutely necessary, and, when it does become necessary, to 
pare down the functions of the main program so that it incorporates only the special- 
izing and input-output aspects of the applied problem at hand. Thus each applied 
problem is subjected to analysis to determine (a) what aspects of it are expressible 
in terms of the existing program set, and (b) what remaining aspects might be of 
future value if expressed as subroutines to be added to the general collection. Every- 
thing else becomes a function of the main program, except that occasionally subrou- 
tines might be used here for certain purely technical reasons (for instance, to break 
down large programs into smaller blocks for reduction of compilation time during 
debugging. 

Sometimes there are aspects of the main program' s functions which for other 
technical reasons seem naturally to require subroutine usage (e.g., conputational 
patterns needed at numerous positions in the program). Such aspects are usually 
handled by methods internal to the main program, i.e., by arithmetic statement func- 
tions or by effective "internal subroutines" utilizing ASSIGNED or COMPUTED GO TO 
statements for linkage (we don't write main programs in FAP). This is done to help 
limit the indiscriminate growth of true subroutines and the attendant naming and 
documentation problems. 

Computational aspects which are considered to be of future value are usually 
discussed by the responsible programmer with others in developing the detailed sub- 
routine specifications. The basic choice of subroutine type has been almost invariably 



12 



Introduction 



made between closed functions and subroutine subprograms.* Beyond this our pro- 
gramming group adheres to general conventions in calling-sequence design and 
terminology. These are detailed in Section 4. Input-output functions are not generally 
permitted to a subroutine unless they are its primary responsibility, in which case the 
external units involved are specified as arguments in the calling sequence, rather than 
assumed. Computational subroutines usually begin with an interlude for checking the 
legality of input-type arguments, and they refuse to perform badly requested compu- 
tations, returning instead a diagnostic error flag as the only output. As a minimum 
we try to make the routines shock-proof with respect to the possibility of loss of con- 
trol (loops, stops, unpredictable transfers). Special care is taken to ensure that the 
subroutine behaves reasonably when faced with conceptually legal but unusual, or 
limiting, or degenerate configurations of input arguments, so as not to create booby 
traps in applications broader than the specific one creating the need for the subroutine. 
Also, we try to see that such configurations appear in the testing programs. 

But there are deeper problems of subroutine design which touch on questions not 
peculiar to the field of programming. By what process does one examine a complex of 
activities and abstract or invent useful subgroupings? With respect to the present 
program set we can pretty well sidestep the difficult part of this question, since the 
subgroupings are broadly based on corresponding and previously established ones of 
mathematical analysis. In particular, a program system meaningful with respect to a 
field of analysis would naturally tend to become a mapping of the operational structure 
of that field, and Volume II will expand on this topic for time-series analysis. The 
more difficult question still remains, however: What discriminates good program 
invention from bad within whatever freedom of decision prevails? Our only suggestion 
here is to recall the commonplace that good invention arises from the dissatisfaction 
of creative individuals familiar with both the cause of their irritation and the tools of 
the trade. The question itself is of clear importance in, say, the task of designing 
program-generating programs, but there is no need to pursue it in the present volume. 



DESIGN FOR SPEED 

We shall conclude this introductory section with a short discussion of one last consid- 
eration, namely that of computer time required. It has affected our programming 
strongly, since we have been dealing with many long empirical time-series and numer- 
ical filters. It has strongly biased our programming toward FAP over FORTRAN, 
and, in general, has decided the issues of tradeoff between speed and space in favor of 
the faster, if longer, programs. 

In Section 3 there is a program category labeled FAST which contains a large 
number of entries. Study of the programs in this category will furnish details of the 
various programming techniques we have used to obtain speed. Volume II will provide 
further discussions of some of these techniques, but for the present we will only ab- 
stract some data relative to the 7094 on program speeds, in the three most important 
areas where our techniques have been significantly superior to elementary approaches: 
correlation or convolution, Fourier transformation, and solution of Toeplitz matrix 
equations. 



*In retrospect, our tendency to avoid writing FORTRAN functions, based on no better 
reason than the fact that one can occasionally confuse them with subscripted variables, 
appears somewhat unfortunate, since we thereby denied ourselves a certain degree of 
flexibility. (Note, for example, that one may call a FORTRAN function as an ordinary 
subroutine subprogram in addition to using it as a numerical entity in an arithmetic 
statement. 
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Our key high-speed correlation or convolution program is PROCOR, whose 
writeup gives a reasonable idea of the techniques employed. Since PROCOR involves 
basically fixed-point arithmetic, a number of higher-level routines based on PROCOR 
have been written for ordinary correlation and convolution floating-point applications. 
They are QACORR, QXCORR, QXCOR1, and QCNVLV. Timing data for the autocorre- 
lation program QACORR are adequate for illustration here. This program achieves 
nothing more complicated than does the following FORTRAN subroutine. 

SUBROUTINE FORAC(X, LX, MXLAG, ACOR) 
DIMENSION X(2), ACOR(2) 



JMAX 


= MXLAG + 1 


DO 20 


J = 1,JMAX 


SUM 


= 0.0 


NMAX 


= LX - J + 1 


DO 10 


I = 1,NMAX 


K 


= J+l 


SUM 


= SUM + X(I)*X(K-1) 


ACOR (J) 


= SUM 


RETURN 




END 





Fig. 1 gives timing information on QACORR and on the above program for data lengths 
varying from about 20 to 10,000, showing that QACORR is inferior for very short 
data but possesses a speed advantage factor of ten or greater for the longer series 
(this factor jumps to around 17 for the 709 or 7090). Similar savings will be realized 
in cross correlation and convolution by the other programs using PROCOR. 

The high-speed harmonic transform programs are based primarily on subroutine 
COSP. They are ASPECT, COSIS1, Q FURRY, QIFURY, and XSPECT. (Subroutine 
FACTOR also uses COSP in finding minimum-phase transients from energy-density 
spectra.) The speed of COSP comes from careful looping logic on stored sinusoids. 
Speeds of ASPECT, which finds cosine transforms of symmetrical data (usually auto- 
correlations in our applications) and which uses folding and splitting logic in addition 
to using COSP, can be 10 to 100 times faster than those of elementary programs. 
Speed-run results for ASPECT are shown in Fig. 2 for various data lengths and fre- 
quency increments. The upswing of the curves in the lower portion of the figure results 
from the gradually dominating influence of the folding and splitting logic for long data. 

Toeplitz matrices arise in many time-series problems, particularly in the deter- 
mination of least-squares filters. These matrices are positive definite Hermitian with 
elements constant along any diagonal, so that if the matrix is n by n, there are only n 
independent elements rather than n 2 . Recursion techniques exist for the solution of 
simultaneous equations involving these matrices , which require computational times 
proportional to n 2 rather than n 3 .* Subroutine WLLSFP or the coordinated pair 
RLSPR and RLSSR handles normal Toeplitz matrix equation problems. RLSPR2, FIRE2, 
MIPLS, MIFLS, and MISS are for use in multidimensional or multi-input problems 
when, for example, the matrix elements themselves become matrices. It is instructive 
to make a comparison between the computation times of ordinary simultaneous-equation 
programs not involving the special Toeplitz assumption and those of recursive pro- 
grams. Such a comparison is made in Fig. 3, showing empirical times of WLLSFP and 
of the general utility subroutine SIMEQ. Analogous curves for the 7090 will show very 
similar relative behavior. 



*An early reference is Levinson' s Appendix to Interpolation, Extrapolation, and Pred- 
diction of Stationary Time Series, by N. Wiener, John Wiley & Sons. 
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FIGURE 1. EMPIRICAL TIME CURVES FOR SUBROUTINE QAC0RR AND FOR AN 
ELEMENTARY FORTRAN PROGRAM IN COMPUTING AUTO- 
CORRELATION FUNCtlONS. 
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FIGURE 2. EMPIRICAL TIME CURVES FOR SUBROUTINE ASPECT IN COMPUTING 
COSINE TRANSFORMS OF AUTOCORRELATIONS OVER THE FULL 
FREQUENCY RANGE. 
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FIGURE 3. EMPIRICAL TIME CURVES FOR SUBROUTINES WLLSFP AND SIMEQ 
IN SOLVING THE MATRIX EQUATION AX = B FOR THE VECTOR X, 
WHERE A IS SQUARE T0EPLITZ OF DIMENSION N BY N. 
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Wiggins, RA,, On factoring the correlations of discrete multivariable stochastic 
processes, Ph. D. Thesis, M.I.T., and Report No. 9 of AF19(604) - 7378, M.I.T., 
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2 

Illustrative 

Usage of Programs 



Examples of the use of the program as an isolated entity appear with each program 
listed in Section 10. Such examples are valuable, but often do not project a sense of 
the use of the program in an applied setting. Volume II of the present writing will give 
numerous illustrations of such usage in the time-series setting for which the program 
collection was developed. It is in keeping with the tenor of the present volume to 
present examples of usage in an applied but utilitarian setting. Such a setting is mean- 
ingful, because a good many of the programs of the collection fall under a utility clas- 
sification in no way specialized to the field of time series. 

The illustrations in the first set given are quite simple to scan and digest. A 
large number of the utility programs have truly elementary functions which are easily 
expressed by a few basic FORTRAN statements, the raison d' &tre of such programs 
being convenience, or speed, or both. The illustration for these programs is a 
sequence of isolated program usages paired with equivalent, basic FORTRAN sequences. 
In this fashion a large number of programs can be covered in a few pages. The selec- 
tions here include all of the minor utility programs which have simple FORTRAN 
translations. The reader should be cautioned that the basic FORTRAN equivalents 
may not be exact in all variations of the sample usage, especially in cases of zero or 
negative-length vectors, or in cases where arguments in calling sequences are equated 
by FORTRAN equivalence statements not shown here. 

The illustrations in the second set given in this section are simply listings of 
some of the testing programs we have used to verify the input-output behavior asserted 
in the program writeups of Section 10. In these test programs we have leaned heavily 
on the use of utility programs previously verified. The test programs must be studied 
with close reference to the program writeups of Section 10, since the test decks have 
no independent documentation. An examination of these listings will also bring out the 
general style we have evolved for writing test programs: this style may be of interest 
to persons with similar problems. 

The third and last set of illustrations consists of three main programs which 
produced the timing data for Figs. 1, 2, and 3 of Section 1. 
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PROGRAM USAGE 




EQUIVALENT BASIC FORTRAN 


CALL ABSVAL(X, 1 1, I2,Y, IANS ) 




DO 10 1*11,12 








j= I — I 1+ 1 




( SAME PROGRAM FOR FIXED POINTI 


[ 10 


Y( J)»ABSF(X( II) 




CALL ADDK(C,X1, X2,...,XN) 




X1=X1+C 








X2=X2*C 












(XADDK FOR FIXED POINT* 




XN*XN*C 




CALL ADDKS(Cl,Xl,Yi, C2 f X2,Y2, 








1 - . - • CN. XN. YN) 




Y2*X2*C2 








(ETC) 




(XADDKS FOR FIXED POINT) 




YN*XN+CN 




CALL AVRAGE(X,LX,XAVG) 




SUM^O.O 








00 10 1=1, LX 






[ 10 


SUM=SUM*X(I) 




{ XAVRGE OR XAVRGR FOR FIXED POINT) 




XAVG=SUM/FLOATF(LX) 




CALL BOOST(X,LX,C,Y) 




DO 10 1=1, LX 




(X800ST FOR FIXED POINT) 


[ 10 


Y(I)=X(I)*C 




TAIL PAR IGF f I T APF . N<*P Af F 1 




IF (NSPACE) 40,60,10 






I 10 


DO 20 1*1, NSPACE 






I 20 


WRITE OUTPUT TAPE ITAPE 


t 30 




I 30 


FORMATdH ) 








GO TO 60 






[ 40 


WRITE OUTPUT TAPE ITAPE 


t50 




I 50 


CHS MAT f 1141 t 






I 60 


CONTINUE 




CALL CHOOSEUIFRST, X,X1,X2, 








1 7.71.72) 


t 10 


X*X1 








(ETC) 








Z=Z1 








GO TO 30 






[ 20 


X*X2 
















Z=Z2 






[ 30 


CONTINUE 




CALL CHSIGN( X. L X. Y ) 




DO 10 1=1, LX 




(SAME PROGRAM FOR FIXED POINT) 


I 10 


YUl—XCIl 




IF ( CHUSETF ( X, XI , X2, Z IFX1 ) ) 




IF (ZIFXi) 20,10,20 




1 40,50,60 


I 10 


X-Xl 








GO TO 30 






[ 20 


X=X2 




(SAME PROGRAM FOR FIXED POINT) 


I 30 


IF (ZIFXI) 40,50,60 




X=DELTAF( Y) 




IF (Y) 20,10,20 






[ 10 


X=1.0 








GO TO 30 




(ARGUMENT MODE IMMATERIAL) 


[ 20 


X=0.0 




(XDELTA FOR FIXED POINT) 


I 30 


CONTINUE 





PROGRAM USAGE 




EQUIVALENT BASIC FORTRAN 


CALL DIVIDECX,LX,D,Y) 

CXOVIDE OR XDVIDR FOR FIXED POINT) 


[ 10 


00 10 1*1, LX 
YII l*XC 11/0 


CALL DIVMCX1, ,XN) 

lAUiVlS UK aUVKIn PUK rlAtU rUllMI f 




X1*X1/C 
(ETC) 

V Kl — V Kl if* 


CALL DIVKS(CI,X1,Y1,..»,CN,XN,YN) 

CXDIVKS OR XDVRKS FOR FIXED POINT) 




Y1*X1/C1 

1 C Tf X 

I c TO I 
YN*XN/CN 


CALL DPRESSCX,LX,C,Y) 
CXDPRESS FOR FIXED POINT) 


[ 10 


DO 10 1*1, LX 

Yd)*xm-c 


CALL DU8LLCX,LX) 

{ DUBLX FOR FIXED POINT) 


[ 10 


DO 10 1*1, LX 
X( I )=2.0*X( I ) 


r 11 i cvruuc (1 VV V VI 

CALL EXCHVo l LXY, X, Y ) 

C SAME PROGRAM FOR FIXED POINT) 


[ 10 


DO 10 I*1»LXY 
TEMP*X( I ) 
XC I )*Y{ I ) 
Yd )*TEMP 


CALL ruUI iLATtAf Yf UUTl 


[ 10 


DU t *0« U 

00 10 1*1, LXY 
D0T=D0T*Xdl*Yd) 


CALL FDGTRC LXY, X, Y,DOTR) 


[ 10 


00TR*0.C 

00 10 1*1, LXY 

J=L XY* 1— I 

D0TR*D0TR*X( I)*Y(J) 


CALL r I XV l X ,LX , l X l 


[ 10 


□0 10 1*1, La 

IX( II*XFIXFIXd)l 


CALL FIXVR(X,LX,IX) 


[ 10 


DO 10 1*1, LX 

IX< I)*XFIXF(XC IH.5) 


CALL PM FUUl l ITAPfc § lOHon Mc5bAUcl 


[ 10 


UOITC nilTOIIT TIDE TTADC If* 

WKIIfc UUIPUi ! Art lIArfc,lU 
FORMAT! 8H MESSAGE) 


Y s bcl XI Xf 1 A» • . • , IXf IT , ILl 

i IGETX FOR FIXED POINT) 




I - I Y I 1 £ I 
I*IX(I) 
CETC) 
1*1 AC I ) 
Y*X(I) 


IF ( INDEXFC I , ICRTCL ) ) 10,20,30 




1*1*1 

IF d-ICRTCL) 10,20,30 


CALL HALVL<X,LX) 
(HALVX FOR FIXED POINT) 


i 10 


DO 10 1*1, LX 
XCI)*XCI)/2*0 



PROGRAM USAGE 


* 
I 
I 


EQUIVALENT BASIC 


FORTRAN 




CALL INTSUM(X,LX,Y> 


{ 


Ym*xm 












IF (LX-1) 30,30,10 










I 10 


DO 20 1*2, LX 










I 20 


Ytn»YC i-ii+xc n 








I API 1 oun rUK rlACU rUlINI I 




rnMTf unc 
CUIM 1 INUfc 








CALL 'lAV/AKbl A| 1A ) 


* 

J 


CUMMUN C 










* 


I X=XLUCr I C J—XLuCr i X 1 ▼! 








r*t i i r\r f v i t \ t i fif \ 
UALL LUtlAl 1 I f lLUUl 


* 
* 


I LUC*XLUCr I X l" I +\ 








CALL MOV£(LX,X,YI 


J 


IF (XL0CF(X|-XL0CF(YI> 


10, 


50, 


30 




I 10 


DO 20 1=1, LX 










I 20 


Y 1 1 i =X ( I] 












GO TO 50 










I 30 


DO 40 1*1, LX 










I 


J=LX*1-I 










I 40 


\J I |%_Vf 1% 

Yl J 1 = X I Jl 










r c A 


CUN 1 INUfc 








CALL MULK ( C, XI , • • • , XN) 


I 


X1=X1*C 












C ETC ) 








{ XMULK FOR FIXED POINT ) 


{ 


XN*XN»C 








CALL MULKblCl,Xl,Yl,4»«*,CN,XN,YNl 


I 

J 


Y1*C1»X I 










* 


# C T/* t 
I ClC 1 








iXMULKo rUK rlXcU PUINli 


j 


V KI C %A m. V Kl 

YN*CN»XN 








CALL MULPLY(X,LX,C,Y> 




DO 10 1*1, LX 








IXMLPLY rUK rlXcU rUlNIJ 


1 lu 


Yl I >-C*X| I J 








A*NTHAF( J,A1,...,AN* 




TEMP(1I*A1 












(ETC) 












TC11Q 1 ki 1 _tli 

TEMPI N l *AN 








(XNTHA FOR FIXED POINT 1 


\ 


A=TEMP( J) 








rtl | Dl IIDMC ( A1 AM 


* 


f*AI 1 CUD f Al A Kit 

CALL bUB I Al , • • • , AN I 








1 7 1 7 HI % 

i Zl , • • • , £N ) 


J 


i cTr \ 
1 ETC 1 








r Al I CIIDI Ml 

LALL bUblN) 


J 


/"All CUD 1 71 7 Kl % 

CALL SUBl £lt • • • ,£Nl 








LALL RcrLcHXf LAft? T 1 


J 


nn i a i _ i iv 
DU 10 1*1, LX 








iXKrLfcC rUK rlAtU rUINi J 


t in 

1 JLU 


Vf f \ — f* _ V f f | 

Y I I 1— C—X| 1 ] 








^ ii i t> c v# c o # v iv v % 
CALL KfcvcR ( X, LX , Y § 


J 


Ir I XLUCr l X I — XLUCr I Y I ? 


10, 


20, 


1 o 

10 




I 10 


N*LX 












GO TO 30 










I 20 


N*(LX+U/2 










I 30 


DO 40 1*1, N 












J*LX+1-I 












TEMP*X( J) 












Y(J)=xm 








(SAME PROGRAM FOR FIXED POINTI 


I 40 


Y(U*TEMP 









PROGRAM USAGE 


I 
1 


EQUIVALENT BASIC FORTRAN 


TAIL R FVFR <s f 1 X . X 1 


-I 


Ms ft ¥4-1 1/9 
IN— I LAt Life. 




! 


00 10 1 = 1, N 






Isl X4>1 — T 




i 


TEMP=X( J I 




i 


X(JI=X(Ii 


(SAME PROGRAM FOR FIXED POINT! 


I 10 


X( I )*TEMP 


Y=RNDF (X) 


1 


Y=FL0ATF(XFIXF(X*.5)) 


Y*RNDDNF(X) 


I 


Y=FLOATF(XFIXF(X)| 










I 10 


Y=FLOATF(XFIXF(X*. 999999991 1 






GO TO 30 




* C \f 


YsFI OATF f XF I XF 1 X--QQQQQQQQ 1 1 




I 30 


CONTINUE 


CALL RNDV(X,LX,Y) 


I 


DO 10 1*1, LX 




I 10 


Yd )=FL0ATF(XFIXF(Xd)*.5)) 


CALL RNDVDN(X,LX,Y) 




00 10 1=1, LX 




& J. V» 


V f T 1 =FI fl A TF ( XF I XF ( X ( I 1 1 

i 1 4 F*rLUHlrt ArlAriAil F 1 


CALL RNDVUP(X,LX,Y) 




DO 30 1=1, LX 




j 


IF (X(IM 20,10,10 




I 10 


Yd )=FLOATF(XFIXF(Xdl*. 99999999) ) 






GO TO 30 






Y f I t =FI flATF f XF I XF 1 X f I 1 — ^ QQQ9Q<3<J9 1 1 

I l I JTl»wMiriAi*Ar»All# m*7^*7fTtwzt 9 




I 30 


CONTINUE 


Y=<; AMFF ( I X 1 


-j 


FGIJFVAI PNCF (Y.IY) 


( XSAME FOR FIXED POINT) 


I 


IY=IX 


IF { SETAPTF(X, XNEW,FVALUE ) ) 


I 


X=XNEW 


1 10,20,30 


j 


IF (FVALUE) 10,20,30 


IF (SETESTF(X,XNEW,XCRTCL) ) 


I 


X=XNEW 


1 10,20,30 


I 


IF (XNEW-XCRTCL) 10,20,30 


CALL SETK(C,X1,X2,..,,XN) 


I 


X1=C 




I 


X2=C 




I 


(ETC) 


(SAME PROGRAM FOR FIXED POINT) 


j 


XN=C 


B P=777777712345 




A=C1 


CALL SETKP(C1,A,B,P, 




B=C1 


1 C2, D,E, F,G,P, 




D=C2 


2 C3,H) 




£=C2 






F=C2 


(SAME PROGRAM FOR FIXED POINT 




G*C2 


OR MIXED MODES) 




H=C3 



PROGRAM USAGE 


{ 

.[ . 


EQUIVALENT BASIC FORTRAN 


CALL $ETKS(C1,A,C2,B,«..,CN,Z) 




A=Cl 




J 




f C * UC Ci O O/* DAM COO CTVCn Dfl f KIT 

IbAMf: PROGRAM PUR FIXED POINT 




(ETC 1 


no urycn unncc 1 
UK nlACU nUUCi » 


J 
J 




CALL SETKV(C,LX,X) 


I 


DO 10 1=1, LX 


(SAME PROGRAM FOR FIXED POINT) 


I 10 


X(I)=C 


CALL SETKVS(C1,LX1,X1, .... 


I 


DO 10 1*1, LX1 


1 CN,LXN,XN) 


I 10 


Xl( I)=C1 




* 




(cauc oonro au cno civcn on tkit 
loAnt PRUbKAM FUR FlXcU PUINT 




nn nn t — i i vm 
UU 90 I S 1,LXN 


no u f v cn aa nn cz c \ 
UK MIXfcU nUUtro I 


I 90 


V kl f t % — f Ki 

XN ill -UN 


CALL SETLIN(B,D,LX,X ) 


{ 


DO 10 1=1, LX 


(XSTLIN FOR FIXED POINTI 


I 10 


X( I )=B*0»FL0ATF(I-1I 


CALL SETLNS(B1,D1,LX1,X1, • ••* 


* 


nn in t _ i i v l 

DO 10 1=1, LX1 


1 O Ki T\ Kl 1 V HI V Kl % 

I oNt UN, LXN, XN1 


r in 
I 10 


Vt 1 T l-.D1.ft.rt1 mCI nATCI T 1 t 

X1(I |=Dl't'Ul*rLuA 1 F ( I — 1 1 




* 


( ETC 1 


(SAME PROGRAM FOR FIXED POINT 


* 


nn nn f_i i vm 
DO 90 1=1, LXN 


OR MIXED MODES) 


I 90 


VUI I I.OKIi.nKlMCI DATCI T it 

XN ( I ) =oN+DN*FL0A 1 F ( I~l 1 


d r=77f 7777iZiH5 


J 
J 


V f 1 1 -mC 1 

X 1 1 I =C 1 


CALL ocTVCP I Xf Clt • tCLtr t 




( t IC 1 


1 Y,01f...,DH f Pf 


! 


X(L)=CL 


2. • • • , 


I 


Y(1)=D1 


3 £,G1,*** , GN 1 




i ctr t 
I fc 1 L t 




J 


v l m t ~»n a* 
Yin l=Un 




1 


(ETC) 






Z(1)=G1 


(SAME PROGRAM FOR FIXED POINT 


* 


(ETC 1 


OR MIXED MODES) 


„{ 


Z (N )=GN 


CALL SETVEC(X,C1,...,CN) 




X(l)=Ci 




* 


f C 7*** 1 

( ETC 1 


i r i yr no ("if* n iu cno CTvcn on f kit t 

(bAME PROGRAM FOR FIXED POINT) 




X 1 N l=CN 


CALL SIFT(X,M,LY,Y) 




* 


DO 10 1=1, LY 






1,1 xf T — 1 \ M.M 

J = I * 1 1 1 J *n 


i c a uc nonro au cno r t vcn on (kit I 
(SAME PROGRAM FOR FIXED POINTI 


f in 
I 10 


Til l=X I Jl 


CALL SQRDEV(X,C,LX,SSQ) 




SSQ=0.0 






nn in i — i i v 
UU 10 I = I , L X 


(XSQDEV FOR FIXED POINT ) 


I 10 


SSQ=SSQ*(X(I)-C)»(X(I)-C) 


CALL SQRDFR(Xt Y f LXYfSSQ ) 




SSQ=0„0 






DO 10 1=1, LXY 


( XSQDFR FOR FIXED POINT) 


I 10 


SSQ=SSQ*(X(I)-Y(I))*»2 


CALL SQROOT(X,LX,Y) 




DO 10 1=1, LX 


(XSQRUT FOR FIXED POINT) 


I 10 


Y(I)=SQRTF(X(in 



I 



[ PROGRAM USAGE 




EQUIVALENT BASIC FORTRAN 




I CALL SQRSUM(X,LX, SSQ) 




SSQ=0. 0 








DO 10 1=1. IX 




[ (XSQSUM FOR FIXED POINT) 


I 10 


SSQ*SSQ*X(I)«X(I) 




I CALL SQUARE (X, LX,Y) 




DO 10 I-1,LX 




I (XSQUAR FOR FIXED POINT) 


I 10 


Y( I )=X( I) »X( I ) 




[ Y=STEPCF(X) 




Vx. 5+SIGNFt * 5. X ) 




[ (ARGUMENT MODE IMMATERIAL) 








[ (XSTEPC FOR FIXED POINT OUTPUT) 








t Y=STEPLF(X) 




IF (X) 20.1C.1C 






I 10 


Y=l .0 








GO TO 30 




[ (ARGUMENT MODE IMMATERIAL) 


I 20 


Y=0.0 




[ (XSTEPL FOR FIXED POINT OUTPUT) 


I 30 


CONTINUE 




Y=XSTEPRF(X) 




IF (X) 20,20,10 






I 10 


Y=1.0 








GO TO 30 




(ARGUMENT MODE IMMATERIAL) 


I 20 


y=0 .0 




(XSTEPR FOR FIXED POINT OUTPUT) 


I 30 


CONTINUE 




[ CALL STZ(LX,X) 




DO 10 1=1, LX 




[ (SAME PROGRAM FOR FIXED POINT) 


I 10 


X(I)»0.C 








DO 10 I»1.LX1 






I 10 


Xl( 11*0.0 








(ETC) 




(SAME PROGRAM FOR FIXED POINT 




DO 90 I=1.LXN 




[ OR MIXED MODES) 


I 90 


XN( I )=0.0 




CALL SUBK(C,X1, ...,XN) 




X1=X1-C 








( ETC ) 




(XSUBK FOR FIXED POINT) 




XN= XN— C 




CALL SUBKS(C1,X1,Y1,...,CN,XN,YN) 




Y1*X1-C1 








(ETC) 




(XSUBKS FOR FIXED POINT) 




YN=XN-CN 




CALL SUM(X,LX,SUM) 




SUM*0.0 








DO 10 I*1.LX 




(XSUM FOR FIXED POINT) 


I 10 


SUM=SUM+X ( I ) 








iunU'U • u 








DO 10 1*1, LX 




(XSMDEV FOR FIXED POINT) 


I 10 


SUMD«SUMD*X(I)-B 




CALL SUMDFR(X,Y,LXY,SUKD) 




SUMD*0„0 








DO 10 I«l,LXY 




(XSMDFR FOR FIXEO POINT) 


I 10 


SUMD=SUMD*X(I)-Y(I) 





PROGRAM USAGE 




EQUIVALENT BASIC FORTRAN 




re (QUTTruCf 1 1ft 1ft Ot\ 
lr 1 owl lUnrl lotnlot ) P lUf lUf 










I 30 


IF (ISENSE-6) 40,40,10 






I 40 


GO TO (1,2,3,4,5,6), ISENSE 






I 1 


IF (SENSE SWITCH 11 20,10 






I 2 


IF (SENSE SWITCH 2) 20,10 








tcitr 






[ 6 


IF (SENSE SWITCH 6) 20,10 




UALL VUU 1 V I A, Y , L a Y , U 1 V , UU 1 9 




nnT— a ft 
UU 1 — U»U 








DO 10 1=1, LXY 






I 10 


D0T*D0T+X(I)*Y(I) 








D0TsD0T/DIV 




CALL VDVBYV(X,Y,LXY, Z) 




DO 10 1*1, LXY 




(XVDRBV OR XVDVBV FOR FIXED POINT) 


t 10 


ZCI)*X(I)/YtI) 




CALL VECOUT(ITAPE,8W6HiOF7.1, 




WRITE OUTPUT TAPE ITAPE,10, 




1 X, 11,12) 


I 1 (X(I), 1*11, 12) 






I 10 


FORMAT! 10F7.1) 




IF (VINDEXF(I,IC,IJ)) 10,20,30 




1=1 +1 j 








IF (I-IC) 10,20,30 




CALL VHNUSVtX,Y,LXY, Z) 




DO 10 1*1, LXY 




IXVMNoV rUR rlXcU rulNIJ 


I 10 


Z(I)*X(I)-Y(l) 




CALL VPLUSV(X,Y,LXY,Z) 




DO 10 1*1, LXY 




(XVPLSV FOR FIXED POINT) 


[ 10 


Z(II*X(II+Y(I) 




CALL VTIMSV(X,Y,LXY,Z) 




DO 10 1*1, LXY 




iXVTMSv FOR FIXED PuINI 1 


[ 10 


Z(I)*X(I)*Yf I) 




X=WHICHF(X1,X2,Y) 




IF (Y) 20,10,20 






[ 10 


X*X1 








GO TO 30 






I 20 


X*X2 




(XWHICH FOR FIXED POINT) 


I 30 


CONTINUE 




IF ( XACTEQF ( X, Y ) ) 10,20,30 




IF (X-Y) 10,40,30 






[ 40 


IF (XI 20,50,20 




( SAME PROGRAM FOR FIXED POINT 


[ 50 


IF (SIGNF(1.,X)-SIGNF(U,Y) ) 




ARGUMENTS ) 




1 10,20,30 




TP (VI !UTTtlV V * VQt 1 1 A OA 1 f\ 

IF I XL 1 Ml I r l X, XA, Xo f f 10,20,30 




IF (X-MAX1F(XA,XB*I 40,20,30 




(SAME PROGRAM FOR FIXED PQ INT 


I 40 


IF (X-MIN1F(XA,XB)) 10,20,20 




ARGUMENTS) 








CALL XL0CV ( L0CV t X 1 » . . . ,XN) 




L0CV(1)*XL0CF(X1) 








(ETC) 








L0CV(N)*XL0CF(XN) 




IF (XOOZEF(I)) ,10,20 




IF (I-2»(I/2II 20,10,20 





SAMPLE TESTING PROGRAMS 



* TEST BLKSUM 
» XEQ 

* LIST8 

* LABEL 
CTLKSUM 

DIMENSION X(9), S(4,4,4>, LS(4,4I, SPACEUO* 
ITEST*0 
7 ITEST=ITESm 

CALL VRS0UT(2,3»14H9H EXAMPLE , I 1 f I TEST f ITEST) 
CALL SETVEC(X,2.,4.,6., 8.1 

CALL SETKVS(-9.,64,S, -9,16,LS, 2.0,l,DVSRJ 
GO TO (1,2, 31, ITEST 

1 00 10 LX=1»4 
DO 10 L-ltLX 

10 CALL BLKSUM(X,LX,L,DVSR,S(1,L,LX|,LS(L,LXH 

CALL VSOUTC2,3,SC 1,1,1 > ,6HS14141,5H4F7. 1,1, 16, 

1 S(l,i,2),6HS14142, 5H4F7.lt l f 16 f S ( 1 , I ,3 ) f 6HS14143 , 

2 5H4F7.1,ltl6 f S ( 1 , 1 , 4 > , 6HS 14144, 5H4F7. 1, 1 , 16 , 

3 LS(1,1>,6HLS1414,3H4I7,1,16> 
GO TO 7 

2 CALL BLKSUM(X,4,2,DVSR,X,LS) 

CALL VS0UT(2,3,X,1HX,5H4F7. 1,1,4, LS,2HLS,2HI7,1, II 

GO TO 7 

3 CALL BLKSUM(X,-l,2,i.0,S,LS) 
CALL BLKSUMCX, 3,0, 1.0, S,LS ) 
CALL BLKSUMCX, 3,4,1.0,S,LS I 
CALL BLKSUMCX, 3,2,0.0, S,LS ) 

CALL VRS0UT(2,3,18H8H S,LS * ,F7. I , 17, SPACE ,S,LS) 

CALL EXIT 

END 



* TEST CMPRA 
» XEQ 

» LIST8 

* LABEL 
CTCMPRA 

GO TO 999 
10 CONTINUE 

Z = CMPRAF(X,Y* 
IZ=XCMPRAF(X,Y) 
FZ=CMPRFLF(X,Y) 

WRITE OUTPUT TAPE 2 , 20 , J , X, Y, Z , X, Y, I Z , X, Y,FZ 
20 F0RMAT(1HQI2,23H. ACOMP TEST - ACOMPFt 015, 1H, 015, 4H) = G15.8/ 
118X8HXAC0MPF(G15.8,1H,G15.8,4H> = G15.8/18X8HFLC0MPF(G15.8,1H, 
2G15.8,4H) - G15.8) 
999 J=J*1 

GO TO (1,2,3,4,5,6,9999), J 

(CONTINUED NEXT PAGE) 



SAMPLE TESTING PROGRAMS 



1 CALL SETKS C1,X,1,Y) 
GO TO 10 

2 CALL SETKS (1,X,-1,Y) 
GO TO 10 

3 CALL SETKS ( 1.2345678, X» 1.2345679, Y) 

GO TO 10 

4 CALL SETKS ( 6HABC0E1 ,X, 6HABC0E2, Y ) 
GO TO 10 

5 CALL SETKS (0,X,-0,Y) 
GO TO 10 

6 CALL SETKS (-50. ,X,-5i. ,Y) 
GO TO 10 

9999 CALL EXIT 
END 



» TEST CRSVM 

* XEQ 

* LIST8 

* LABEL 
CTCRSVM 

DIMENSION AA< 10001 , BBC 1000) ,CC( 1000) , SPACE! 1000) 
COMMON AA,BB,CC, SPACE 
10 J»J*1 

CALL VRSOUT i 2 ,-1 , 20HIX 12 , 12H. CRSVM TEST, J, J) 

CALL RDATA ( 4, 2, I ANS, SPACE ,4HNRAC ,NRAC, 5HNC ARB, NCARB ,4HNCBC ,NCBC , 

1 3HLAA,LAA,2HAA,AA,3HLB8,LBB,2HBB,BB,6HZFNBTR, ZFNBTR, 6HIFSTLG, 

2 IFSTLG,3HLCC,LCC) 

CALL CSOUT { 2, 1 ,NRAC,4HNRAC,NCARB,5HNCARB,NCBC,4HNCBC,LAA,3HLAA, 
1 L8B,3HLBB» ZFNBTR, 6HZFNBTR, I FSTLG, 6H IFSTLG, LCC » 3HLCC ) 
CALL MOUT ( 2,1, AA,2HAA,NRAC,NCARB,LAA) 
CALL MOUT ( 2, 1,BB,2HBB,NCARB,NCBC,LBB) 

CALL CRSVM (NRAC, NCARB, NCBC,LAA,AA,L8B,BB, ZFNBTR, IFSTLG, LCC, CO 
CALL MOUT (2,3,CC,2HCC,NRAC,NCBC,LCC) 

GO TO 10 
END 
» DATA 

NRAC=1 NCARB* 2 NCBC=3 LAA«4 AA*l. , 2. , 3. ,-2. ,5. ,-4. , 1. ,-1. 
LBB-2 BB=3.,2.,4.,3.,l.,-i.,-2.,-3.,-2.,2.,4.,-5. ZFNBTR*0. 
lFSTLG=-2 LCC = 7 RETURN 
ZFNBTR=1. RETURN 



SAMPLE TESTING PROGRAMS 



» TEST GETX 

* XEQ 

* LIST8 

* LABEL 
CTGETX 

DIMENSION XC5ltIXf 51 « 11(71 9 12(3} 9 C( 10) 
CALL SETLIN (1«,1.,5,X) 
CALL SETVEC ( IX, 1 , 2, 3, 4, 5 ) 
11=4 

CALL VRSOUT ( 2, 2, 35H 13, 26H. GETX,XGETX INPUTS - II = 13, C, 1,11) 

CALL VOUT (2,1,X,1HX, 6H10F6. 1 , 1 , 5 ) 

CALL VOUT (2,l,IX,2HIX,4H10I6,l,5) 

Xl« GETX (X,U) 

IXl=IGETX(IX,ll) 

CALL VRSOUT ( 2,2,35H4X14H0UTPUTS - X * F6.2,4X4HIX * 16, C, XI, 1X1} 
CALL SETVEC (11,4,1,1,3,5,2,1) 
CALL SETVEC (12,1,7,5) 
13*3 

CALL VRSOUT ( 2,2, 28HI3, 22H, GETX,XGETX INPUTS - ,2,2) 
CALL VSOUT (2,1,X,1HX,6H10F6.2,1, 5, IX, 2HI X , 4H10 1 6, 1 , 5, 1 1 ,2H 1 1 , 
1 4H10I6,1,7,I2,2HI2,4H10I6,1,3, 1 3, 2H 13, 4H10 16 , 1 , 1 ) 
X1=GETX (X,I1,I2,I3) 
IX1*IGETX(IX,I1,I2,I3) 

CALL VRSOUT ( 2, 2, 35H4X14H0UTPUTS - X * F6.2,4X4HIX = I6,C,X1,IX1) 

CALL EXIT 

END 



* TEST INTHOL 

* XEQ 

* LIST8 

* LABEL 
CTNTHOL 

DIMENSION H0L(50), FMT(50), DATA(50I 
ITEST * 0 
7 ITEST * ITEST+1 

CALL SETKS(1,NH0L, 6H-53. 31 , HOL , 6H( F6. 2 ) , FMT, 1 , NDATAD ) 
CALL VRS0UT(2,3,14H9H EXAMPLE ,11, ITEST, ITEST) 
GO TO (1,2, 3), ITEST 

1 CALL INTHOL(NHOL, HOL, FMT, NDATAD, NOATAA, DATA) 
CALL VS0UT(2,3,NDATAA,6HNDATAA,2HI7,1,1, 

1 DATA,4HDATA,4HF9.2,1,1) 
GO TO 7 

2 NDATAD « 6 
GO TO 1 

3 CALL SETKS(2,NH0L, 3HXYZ,H0L, 6H 5 -9,HGL(2), 3, NDATAD) 
CALL INTHOL ( NHOL , HOL , 6H A6 , 2 1 3 , NDATAD ,NDATAA , DATA ) 

CALL VS0UT(2,3,NDATAA,6HN0ATAA,2HI7,l,l, 
1 DATA,4HDATA,9H1X,A3,2I7,1,3) 
CALL EXIT 
END 



SAMPLE TESTING PROGRAMS 



* TEST LIMITS 

• XEQ 

♦ LIST8 

* LABEL 
CTIMITS 

DIMENSION SC3) 

CALL LIMITSU, IANS, -0,-0,1, -0,+0,l, +0,-0,1, +0,+0,i, 

1 -0,-1,-0, -0,-1, +0, +0,-1,-0, +0,-1, +0, +0,+0,+0» +0,+0,-0, 

2 +0,-0, +0, +0,-0,-0, -0,+0,+0, -0,+0,-0, -0,-0, +0, -0,-0,-0) 
CALL VRSOUTC2, 3, 26H20H EXAMPLE 1. IANS « ,14, S, IANS) 
CALL LIMITS( 1,IANS1, 1.0, 2.0, 3.0) 

CALL LIMITS(21,IANS2, 3,1,4, 3.,1.,4., -3.,-4.,-l., 1,1,4, 1,2,3, 
1 4,1,4) 

CALL LIMITS(3l,IANS3, 0.,0.,0., 1,1,1, -1,-1,-1, 3,1,2, 0,1,2) 

CALL VRSOUT(2, 3, 32H25H EXAMPLE 2. IANS1...3 » ,314, S, 
I IANS1, IANS2, IANS3) 

CALL LIMITS ( l,IANSi, 1.0,3.0,2.0) 

CALL LIMITS(21,IANS2, 3,4,1, 3.,4.,1., -3.,-l.,-4., 1,4,1, 1,3,2, 
1 4,4,1) 

CALL LIMITSC31, IANS 3 , 0.,0.,0., 1,1,1, -1,-1,-1, 3,2,1, 0,2,1) 

CALL VRS0UTI2, 3, 32H25H EXAMPLE 3. IANS1...3 = ,314, S, 
1 IANS1, IANS2, IANS3) 

CALL EXIT 

END 



» TEST SHUFFL - NEEDS LOGICAL 9 

* XEQ 

» LIST8 

* LABEL 
CTHUFFL 

DIMENSION IRD(IOO), ISP ACE < 10 ) , I XSHF 1 { 10 ) , I XSHF2 ( 10 ) 
ITP=9 

CALL SETVECt I RD, 1,0, 0,9 ,7,3,2,5, 3, 3, 7, 6, 5,2,0, 1,3, 5, 8, 6, 3, 4, 6, 7, 3, 

1 5,4,8,7,6,8,0,9,5,9,0,9,1,1,7,3,9,2,9,2,7,4,9,4,5, 

2 3,7,5,4,2,0,4,8,0,5,6,4,8,9,4,7,4,2,9,6,2,4,8,0,5, 

3 2,4,0,3,7,2,0,6,3,6,1,0,4,0,2,0,0,8,2,2,9,1,6,6,5) 

REWIND ITP 

WRITE OUTPUT TAPE ITP, 10, ( IRD( I ) , 1=1 t 100 ) 
10 F0RMAT(50U, 29X, 1H ) 
REWIND ITP 

CALL SHUFFL ( ITP,7,ISPACE,IXSHF1) 
CALL SHUFFL ( ITP,10,ISPACE,IXSHF2) 
CALL VS0UT(2,5, IXSHF1,6HIXSHF1, 8H20X, 1014, 1, 7, 
1 IXSHF2,6HIXSHF2,8H20X, 1014, 1,10) 

REWIND ITP 
CALL EXIT 
END 



SAMPLE TESTING PROGRAMS 



» TEST SIFT 

* XEQ 

» LIST8 

* LABEL 
CTSIFT 

DIMENSION XC50), XS1C50), XS2I50), XS3I5Q), XS4C50), XS5(50>, 
1 XS6C50), FMTC2) 

CALL SETLINU., l.,10,X> 
CALL SETM-9., XS5 f XS6) 

CALL PLURNSCX»0«3 9 XS1« X,1,3,XS2« X,3,3,XS3, X«3 9 ltXS4, 
1 X,-1,3,XS5, X f l,0tXS6, X 9 5,2,X) 

CALL SIFT<4) 

CALL FMTOUT( 2, 20H/////»11H EXAMPLE 1.) 
CALL SETVEC(FMT,6HCiOX, 1,6H0F5.1)) 

CALL VSOUT(2»3, XSl f 3HXS1,FMT , 1 ,3, XS2,3HXS2,FMT, 1,3, 

1 XS3,3HXS3,FMT,1,3, XS4, 3HXS4, FMT, 1 , 1 , XS5, 3HXS5,FMT, 1 , 1 , 

2 XS6,3HXS6,FMT, 1, 1, X , 1HX, FMT, 1 , 10 1 
CALL EXIT 

ENO 



* TEST SIZEUP, SIZUPL 

* XEQ 

* LIST8 

* LABEL 
CTIZEUP 

DIMENSION X(10), INDEXKIO), INDEX2U0) 
ITEST = 0 
7 ITEST * ITEST+1 
LX = 5 

CALL SETVECU, 3. ,-10. ,-1 . , 2. ,0. ) 
GO TO (1,2, 3), ITEST 

1 CALL SIZEUP(X,LX,INDEX1I 
CALL SIZUPL(X,LX,INDEX2) 

CALL VRS0UTC2,3,14H9H EXAMPLE , I 1 , I TEST, ITEST ) 
CALL VSOUT(2,3, INDEX1,6HINDEX1,3H5I5, 1, 5, 
1 IN0EX2,6HINDEX2,3H5I 5,1,5* 

GO TO 7 

2 CALL SETVECU , 1HX, 1HA, 1HC, 1HN, 1HA ) 
GO TO 1 

3 CALL EXIT 
END 



SAMPLE TESTING PROGRAMS 



* TEST TIMA2B 

• XEQ 

» LISTS 

♦ LABEL 
CTTMA2B 

COMMON X, SPACE 
DIMENSION X( 1001) , SPACE (300) 
B XLXA*Q53400000000 

CALL SETKV ( XLXA, lOOit X ) 
LOCB=XLOCF(XI 
CALL CLKON 
10 J*J*l 

CALL VRSOUT ( 2,2,21H1XI2, TIMA2B TEST,J,J) 

CALL RDATA (4,0, I ANS, SPACE, 4HNREG,NREG, 6HZNDUMP, ZNDUMP, 6HM I NACC , 
1 MINACCI 
CALL CLOCKi(i,TIME) 

CALL TIMA2B ( LQCB-NREG, LOCB, M INACC, SECS ) 
CALL CL0CKi(2,TIMEI 

CALL CSOUT C2, 1,NREG,4HNREG,MINACC»6HMINACC, SECS, 4HSECS, TIME, 
1 4HTIME) 
GO TO ID 
END 

• OATA 

NREG=1000 MINACC=100 ZNDUMP=1. RETURN 

NREG'100 ZNDUMP*0 RETURN 

NREG=10 RETURN 

NREG=2 RETURN 

NREG=1 MINACC^lOO RETURN 



SAMPLE TIMING PROGRAMS 



* TIME TEST QACORR AND FORAC 

* XEQ 

» LIST8 

* LABEL 
CTIMQAC 

DIMENSION X(50QO>, SPACE ( 12000 1 , ACQR(5000) 
COMMON SPACEt X, ACOR 

C 

C OUTERMOST LOOP DECIDES WHETHER FULL AUTOCORRELATION OR 

C 1/10 AUTOCORRELATION IS TO BE COMPUTED. THE NEXT LEVEL LOOP 

C SELECTS ONE OF 5 ACCURACY CONSTANTS FOR QACORR. 

C 

DO 100 IXFR*1,2 

FRCTN * NTHAFUXFR, .10, 1.01 

DO 100 IXA*1,5 

MXACC = XNTHAFUXA, 25,50,100,250,500) 

C 

C THE INNERMOST LOOP SELECTS ONE OF 7 DATA LENGTHS, ACQUIRES THE DATA, 

C TIMES THE CORRELATION PRODUCED BY QACORR AND THEN BY FORAC, 

C EXCEPT THAT OPERATION OF FORAC IS BYPASSED FOR DATA LENGTHS 

C EXCEEDING 1000, AND FOR ACCURACY INDICES OTHER THAN 1 . 

C 

DO 100 IXL=1,7 

LX = XNTHAF ( IXL , 25,50,100,250,500,1000,5000) 
MXLAG = XFIXF(FRCTN»FLQATF(LX) I - 1 
CALL GIVEX (LX, X) 
CALL TIMSUBC50, SECSQA) 

CALL QACORRCX, LX, MXACC, MXLAG, SPACE, ACOR, IANS) 
CALL VRS0UTC2, 2, 

1 49H34H LX, MXACC, MXLAG, IANS, SECSQA * f 416, F12.4, 

2 SPACE, LX, MXACC, MXLAG, IANS, SECSQA) 
IF (IXA-1) 100,70,100 

70 IF (LX-1000) 80,80,100 
80 CALL GIVEX (LX, X) 

CALL TIMSUB(50, SECSFA) 

CALL FORAC (X, LX, MXLAG, ACOR) 

CALL VRS0UT(2, 2, 36H21H LX, MXLAG, SECSFA = , 215, F12.4, 
1 SPACE, LX, MXLAG, SECSFA) 

100 CONTINUE 
CALL EXIT 
END 



SAMPLE TIMING PROGRAMS 



* FORAC, FORTRAN AUTOCORRELATION FOR COMPARISON WITH QACORR 

* LIST8 
» LABEL 
CFORAC 

SUBROUTINE FORACCX, LX f MXLAG, ACOR) 

C 

C TOKEN DIMENSIONS 
C 

DIMENSION X(2), ACOR<2) 

JMAX = MXLAG ♦ 1 

DO 20 J=1,JMAX 

SUM * 0.0 

NMAX = LX - J ♦ 1 

DO 10 I*1,NMAX 

K = J + I 

10 SUM * SUM ♦ xm*XCK-i) 

20 ACOR (J) = SUM 

RETURN 

END 



• GIVEX, PROVIDES A DATA VECTOR FOR QACORR TIME TESTS 
» LISTS 

* LABEL 
CGIVEX 

SUBROUTINE GIVEXUX, X) 

C 

C TOKEN DIMENSIONS 
C 

DIMENSION X( 2) 

C 

C THE DATA VECTOR PROVIDED IS A MORE OR LESS WHITE LIGHT SERIES 
C WITH VALUES IN THE RANGE -1.0 TO ♦l.O . 

C 

DO 10 1=1, LX 
10 Xtl> « C0SF(100.*FL0ATF(in 

RETURN 
END 



SAMPLE TIMING PROGRAMS 



* TIME TEST ASPECT 

* XEQ 

* LIST8 

* LABEL 
CTIMASP 

DIMENSION AC0RI5001I, SPECTClOOl), SPACEI2010), COSTA8U001) 
COMMON ACGR, SPECT, SPACE, COSTAB 

C 

C INITIALIZE BY SETTING UP THE AUTOCORRELATION OF A SAW-TOOTH* 

C 

CALL SETLIN(500i.t -1., 5001, ACOR* 
CALL SQUARE! ACOR, 5001, ACOR) 

C 

C OUTER LOOP SELECTS ONE OF SIX FREQUENCY INCREMENT CONSTANTS, 

C ANO ESTABLISHES THE CORRESPONDING COSINE TABLE. 

C 

DO 100 IXMFRQ*1,6 

MFREG = XNTHAF ( IXMFRQ, 25,50,100,250,500,10001 
CALL COSTBL C MFREQ, COSTAB) 

C 

C INNER LOOP SELECTS ONE OF 8 CORRELATION LENGTHS AND PROCEEOS WITH 
C THE TIMING, BUT HAS A BYPASS FOR CASES IN WHICH THE NO. OF 
C FREQUENCIES EXCEEDS THE CORRELATION LENGTH. 
C 

DO 100 IXMXLG«1,8 

MXLAG * XNTHAFi IXMXLG, 25,50,100,250,500,1000,2500,50001 
IF ( MXLAG-MFREQ) 100,70,70 
70 CALL TIMSUBt 50 , SECSAS) 

CALL ASPECTCACOR, MXLAG, COSTAB, MFREQ, 0, MFREQ, 
1 1.0, SPECT, SPACE, DUMMY, ERR) 

CALL VRS0UTI2, 2, 

1 45H29H MXLAG, MFREQ, ERR, SECSAS = , 216, 2F12.4, 

2 SPACE, MXLAG, MFREQ, ERR, SECSAS) 
100 CONTINUE 

CALL EXIT 
END 



SAMPLE TIMING PROGRAMS 



» TIME TEST WLLSFP AND SIMEQ 

* XEQ 

* LIST8 

* LABEL 
CTIMWAS 

DIMENSION X(502), R(5Q2), G(500), A(501), CUOIO), SPACE ( 10C2 ) , 
1 AA(IOOOO), BB(lOl), E(lOl) 

COMMON AA, SPACE, C 

C 

C INITIALIZE BY SETTING UP THE NORMALIZED AUTOCORRELATION OF A SAWTOOTH 

C IN RU...501), AND A LINEAR RIGHT HAND SIDE IN G11...50C). 

C (THE NORMALIZATION IS NECESSARY TO PREVENT OVERFLOW IN SIMEQ* ) 

C THE VARIABLE NAMES ARE CHOSEN AS DEFINED BY WLLSFP. 

C 

CALL SETLINIO.O, i.C f 501, X) 
CALL WAC (501, X, 501, R) 
CALL DIVIDEIR, 501, R, Rl 

LR * 500 

CALL SETLINI 1*0, 1.0, 500, G) 
CALL DIVIDEIG, 500, GI500), G) 

C 

C LOOP SELECTS ONE OF 8 MATRIX SIZES, LA, RANGING FROM 3 TO 500, 
C TIMES WLLSFP FOR THIS SIZE, AND THEN, PROVIDED LA DOESN'T 
C EXCEED 100, TIMES SIMEQ. 

C 

DO 100 IXLA=1,8 

LA » XNTHAF ( IXLA, 3,5,10,25,50,100,250,500) 

CALL TIMSUBI 50, SECSWL) 

CALL WLLSFPiLR, R, G, LA, A, CI 

CALL VRSOUT ( 2, 2, 28H14H LA, SECSWL * , 15, F12.4, 
1 SPACE, LA, SECSWL) 

IF (LA-100) 80,80,100 

C 

C SINCE SIMEQ DESTROYS BOTH THE INPUT MATRIX AND THE RIGHT HAND SIDE, 
C THESE INPUTS MUST BE ESTABLISHED FOLLOWING A CALL INTMSB STATEMENT 
C AND PRIOR TO THE CALL TIMSUB STATEMENT. 

C 

80 CALL INTMSB 

CALL REVER (R, 501, SPACE) 

CALL REVER (SPACE, 500, SPACEI502)) 

DO 90 1*1, LA 

K = 502 - I 

J = 1 ♦ U-1)«LA 
90 CALL MOVE (LA, SPACE(K), AA(J)) 

D = 1.0 

CALL MOVE (LA, G, BB) 
CALL TIMSUB(50, SECSIM) 

CALL SIMEQ (LA, LA, 1, AA, BB, D, E, ERR) 

CALL VRS0UT(2, 2, 34H19H LA, ERR, SECSIM * , 15, 2F12.4, 
1 SPACE, LA, ERR, SECSIM) 

100 CONTINUE 
CALL EXIT 
END 



Program 
Categorizations 



The usages presented in Section 2 are only samples, and highly specialized ones at 
that. For systematic access to programs of interest one needs an orderly indexing 
such as that provided by the general sortings discussed in this section. The charac- 
teristics on which these categorizations are based can be broadly divided into func- 
tional and nonfunctional ones. 

The functions performed by the programs of Section 10 can be grouped into the 
following fifteen classes. 



1. 


Administration 


9. 


Probability and statistics 


2. 


Input-output 




computations 


3. 


Data transmission and access 


10. 


Integration and differentiation 


4. 


Data-form changing 


11. 


2-D array and 3-D array 


5. 


Data generation 




operations 


6. 


Data inquiry 


12. 


Polynomial computations 


7. 


Elementary numerical 


13. 


Correlation and convolution 




functions 


14. 


Harmonic transformation 


8. 


Miscellaneous numerical 


15. 


Miscellaneous spectral -analysis 




functions 




operations 



In the following Summary of Functional Classifications, each of these classes 
is broken down into a number of subclasses or categories, according to which the pro- 
grams are sorted in the bulk of this section. This summary thus delineates the scope 
of the programs and constitutes a star ting point in a functionally oriented search of the 
library. It should be noted that there is some overlap in the category definitions. More- 
over, programs with multiple functions may appear in two or more of the categories. 

The remainder of the section is then devoted to program sortings based on non- 
functional characteristics such as authorship, language, linkage, and equipment uses, 
and on subjective qualities such as speed and utility. The categories used there are 
self-explanatory except, perhaps, for the term "FAP necessarily," by which we imply 
that it is either impossible or extremely awkward to express the function performed 
using only basic FORTRAN statements. 
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•»»»*•**•**•••••*•»*•»*«•**•»* 

* 1. ADMINISTRATIVE PROGRAMS » 
*»•»*•****••*•***••»•»»»*•*•»* 

FOR CONTROL OF PROGRAM FLOW 

FOR EXPANDING SYSTEM CAPABILITY 

FOR UNORTHODOX SUBROUTINE USAGE 

FOR INDEX LOGIC 

FOR DOCUMENTING EXECUTIONS 

FOR EQUIPMENT CONTROL 

FOR PROGRAM TIMING 

FOR ABSOLUTE MEMORY INFORMATION 

FOR PROPER USE OF MISNAMED VARIABLES 

»**»*••**»*»••»»••*«»••»**** 

* 2. INPUT-OUTPUT PROGRAMS » 
»»»*»**»»*»••»»»**»»••••»*•• 

FOR BCD INPUT TO CORE 
FOR BINARY INPUT TO CORE 
FOR BCD OUTPUT FROM CORE 
FOR BINARY OUTPUT FROM CORE 
FOR GRAPHICAL OUTPUT FROM CORE 
FOR FORMAT PURPOSES 



•*•»••»*»•••»•*•••••»»*«•• 

* 3. DATA TRANSMISSION * 
» AND ACCESS PROGRAMS * 
»»»••«*•»»••»»**»»•»•»*»•* 

FOR STORAGE-TO-STORAGE MOVEMENT 
FOR STORAGE-TO-TAPE MOVEMENT 
FOR TAPE-TO-STORAGE MOVEMENT 
FOR TAPE-TO-TAPE MOVEMENT 
FOR INFORMATION STORAGE 
FOR INFORMATION RETRIEVAL 



»»»***«»»«*»*»*»***» »*** »••»»**•** 

» 4. DATA FORM-CHANGING PROGRAMS * 
**•»*«•**•****»***•**•**»»••»•**»* 

FOR CONVERTING DATA MODE 

FOR PACKING DATA 

FOR UNPACKING DATA 

FOR SCALING DATA 

FOR NORMALIZING DATA 

FOR ROUNDING DATA 

FOR SHIFTING DATA 

FOR CHANGING DATA SPACING 



********••**••*•*••••«***•*» 

* 6* DATA INQUIRY PROGRAMS * 



FOR FINDING EXTREMAL VALUES 

FOR COMPARING DATA 

FOR SEARCHING DATA 

FOR SELECTING OATA 

FOR ORDERING DATA 

FOR CLASSIFYING DATA 



•••»• •••*••»•*«*»»»•»••»«*• 

» 7. ELEMENTARY NUMERICAL « 
* PROGRAMS * 
»•»•»••••*«»*••••»*»«**•*«• 

FOR ADDITION 

FOR SUBTRACTION 

FOR MULTIPLICATION 

FOR DIVISION 

FOR MODIFYING SIGN 

FOR RAISING TO POWERS 

FOR TAKING ROOTS 

FOR TRIGONOMETRIC FUNCTIONS 

FOR COLLAPSING VECTORS 

FOR ROTATING VECTORS 

FOR REVERSING VECTORS 

FOR EXCHANGING VECTORS 

FOR REFLECTING VECTORS 



* 8. MISCELLANEOUS NUMERICAL » 

* PROGRAMS » 
»**•»••»•***•***••••»*••***«•• 

FOR INTERPOLATION 

FOR SAMPLE BASE CHANGING 

FOR GENERATING SINUSOIDS 

FOR TRIGONOMETRIC FUNCTIONS 

FOR TREATING ODD AND EVEN PARTS 

FOR FITTING EQUATIONS TO DATA 

FOR CONTOURING 

FOR DELTA AND STEP FUNCTIONS 
FOR CONVERTING COMPLEX NUMBERS 
FOR MOVING SUMMATION 
FOR INVERTING FUNCTIONS 
FOR DOT PRODUCTS 



* 5. DATA GENERATING PROGRAMS » 
**»•***•*»•»**•••*•»*»•**•••*»* 

FOR GENERATING HOLLERITH 
FOR GENERATING RANDOM NUMBERS 
FOR GENERATING SINUSOIDS 
FOR GENERATING SCALARS 
FOR GENERATING 1-D ARRAYS 
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»*»****••**•**»»*«»*#**»***•**••*• 

* 9. PROBABILITY AND STATISTICS * 
****»••*•»»*•*»***»•****••••»••»»• 

FOR FINDING MOMENTS 

FOR FINDING AVERAGES 

FOR FINDING R.M.S. VALUES 

FOR FINDING SUMS OF SQUARES 

FOR FINDING SUMS OF DIFFERENCES 

FOR GENERATING RANDOM NUMBERS 

FOR RANDOMIZING DATA 

FOR FINDING DISTRIBUTIONS 

FOR PROBABILITY TRANSFORMATION 

FOR CHI-SQUARE ANALYSIS 

FOR DEPENDENCY TESTING 

FOR NORMAL CURVE INTEGRATION 



»****»*****»*»»*»•»»*«*»••***•*» 

• 10. INTEGRATION AND * 

* DIFFERENTIATION PROGRAMS * 
•**»•»•*»»••**•**•»*•*»•»•»»*»*» 

FOR DEFINITE INTEGRATION 
FOR INDEFINITE INTEGRATION 
FOR DIFFERENTIATION 
FOR INDEFINITE SUMMATION 
FOR DIFFERENCING 



*»•»»*»•»**»*•*»*•**»•«•** 

* 11. 2-D ARRAY AND * 

* 3-D ARRAY PROGRAMS * 
»*•**»»»*#*•*»»**•»»**»*«» 

FOR MATRIX MULTIPLICATION 

FOR MATRIX INVERSION 

FOR SOLVING MATRIX EQUATIONS 

FOR DETERMINANT EVALUATION 

FOR MATRIX TRANSPOSITION 

FOR MATRIX FACTORIZATION 

FOR 2-D ARRAY ROTATION 

FOR INTERPOLATING 2-D ARRAY COLUMNS 

FOR 2-D ARRAY DOT PRODUCTS 

FOR 2-D ARRAY CORRELATION 

FOR 2-D ARRAY FOURIER TRANSFORMATION 

FOR SOLVING 2-D ARRAY EQUATIONS 

FOR MATRIX VECTOR REVERSAL 

FOR MATRIX VECTOR DOT PRODUCT 

FOR MATRIX VECTOR CORRELATION 

FOR SOLVING MATRIX VECTOR EQUATIONS 



»•*••»•»»•••»»•»••»•••«•••• l 

* 12. POLYNOMIAL PROGRAMS * I 



FOR POLYNOMIAL EVALUATION 
FOR FINDING POLYNOMIAL ROOTS 
FOR POLYNOMIAL MULTIPLICATION 
FOR POLYNOMIAL DIVISION 
FOR POLYNOMIAL SQUARE ROOTS 
FOR SYNTHESIZING POLYNOMIALS 



* 13. CORRELATIONS ANC • 

* CONVOLUTIONS » 



FOR AUTOCORRELATION 
FOR CROSS-CORRELATION 
FOR CONVOLUTION 
FOR DOT PRODUCTS 



* 14. HARMONIC TRANSFORMS « 
»•»»••••••••*»••••••*••»•«» 

FOR COSINE TRANSFORMATION 

FOR SINE TRANSFORMATION 

FOR FOURIER TRANSFORMATION 

FOR INVERSE FOURIER TRANSFORMATION 



* 15. MISCELLANEOUS SPECTRAL « 

* ANALYSIS PROGRAMS » 
**»**»•»••*•»*** »*»•»•*•*••*** 

FOR DANIELL WEIGHTING 

FOR SPECTRAL FACTORIZATION 

FOR GENERATING NUMERICAL FILTERS 

FOR CONVERTING TO AMPLITUDE AND PHASE 

FOR CONVERTING TO REAL AND IMAGINARY 

FOR SPECTRAL COMPARISONS 

FOR GENERATING SINUSOIDS 



Time-Series Computations in FORTRAN and FAP 



The sorted lists which will follow below need some introduction with regard to 
format. First of all, the sortings have been made on the basis of names of principal 
entries, and the lists are alphabetically ordered with respect to these names. In the 
case of multiple-entry programs, the names of the secondary entries appear as a 
parenthetical list following each appearance of the principal entry name. However, 
a parenthetical list following a name is not necessarily a list of secondary entries; it 
may alternatively be a list of functionally related programs. For example, each 
appearance of the Fourier-transform program QFURRY is followed by a parenthetical 
reference to the inverse Fourier -transform program QIFURY, and conversely. 

Secondly, it should be noted that we run into an occasional problem resulting 
from the fact that the present sortings are necessarily based on six-character names 
for the principal entries, whereas in the program listings of Section 10 we sometimes 
have appended serial numbers and/or computer numbers to distinguish between pro- 
grams of identical principal entry names. The sortings have been made on the basis 
of effective names . The effective names are identical to the principal entry names in 
cases where no ambiguity can arise. Effective names for the exceptional cases are 
listed below. 



Effective Name 


True Name 


Effective Name 


True Name 


CLOCK1 


CLOCK1 (7090) 


LINE 


LINE (709) 


CNVLV2 


CONVLV-II 


LINE90 


LINE (7090) 


DISPLA 


DISPLA (709) 


LINEH 


LINEH (709) 


DSPL 90 


DISPLA (7090) 


LINH90 


LINEH (7090) 


FRAME 


FRAME (709) 


LINEV 


LINEV (709) 


FRAM90 


FRAME (7090) 


LINV90 


LINEV (7090) 


FT24II 


FT24 -II 


MULK2 


MULK -II 


HST2 


HSTPLT -II 


SETK2 


SETK -II 


HST309 


HSTPLT -III (709) 


SETKS2 


SETKS -II 


HST390 


HSTPLT -III (7090) 


TIMA2B 


TIMA2B (7094) 
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PROGRAMS SORTED BY FUNCTION 



•»*»•*»*»•*«*••**••••••••••»** 

* 1. ADMINISTRATIVE PROGRAMS » 
»*»•••»»»•»»*•»*»•»**••»••»*»• 



FOR CONTROL OF PROGRAM FLOW 
INDEX (CHUSET, SETAPT, 



SETEST, VINDEX), SEVRAL (PLURALS 



FOR EXPANDING SYSTEM CAPABILITY 

FNDFMTf GETX ( IGETX), LOCATE 
SETSBV, SETUP, STORE» WHERE, 
ONLINE ( (STH), (STHDI, (STHMII, 
EOFSET, (TSH), ( TSHM) ) , RPLFMT, 
VARARG. 



( ARG, CALL, CALL2, RETURN, 

XARG, XINDEX, XNAME, XNARGS I , 

PLURNS, RDATA, REREAD (ENDFIL, 

SAME ( XSAME), SEVRAL (PLURAL!, 



FOR UNORTHODOX SUBROUTINE USAGE 



LOCATE ( 

WHERE, 
VARARG. 



ARG, 
XARG, 



CALL, 
XINDEX, 



CALL2, 
XNAME, 



RETURN, SETSBV, SETUP, 
XNARGS), PLURNS, SEVRAL 



STORE, 
C PLURAL), 



FOR INDEX LOGIC 

FASTRK, GETX ( IGETX ) , INDEX 

LOCATE ( ARG, CALL, CALL2, 

WHERE, XARG, X INDEX, XNAME, 



(CHUSET, SETAPT, SETEST, VINDEX), 
RETURN, SETSBV, SETUP, STORE, 
XNARGS ) . 



FOR DOCUMENTING EXECUTIONS 
DADECK, LISTNG, MEMUSE, 



RDATA, XLCOMN. 



FOR EQUIPMENT CONTROL 

CARIGE, CLKON, FRAME ( FRAM90) , 

(STHM)), REREAD (ENDFIL, EOFSET, 

SWITCH, TRMINO, ZEFBCD (ZEFBINI. 



FSKIP, ONLINE ( (STH), ISTHD), 
(TSH), (TSHM)), RSKIP, SETINO, 



FOR PROGRAM TIMING 
CLKON, CLOCK1, 



TIMA2B, TIMSUB (INTMSB), 



FOR ABSOLUTE MEMORY INFORMATION 

IXCARG, LOC, MEMUSE, XLCOMN, 



XLOCV. 



FOR SUBROUTINE LIBRARY STUDY 

(NO ENTRIES FOR THIS CATEGORY) 

FOR PROPER USE OF MISNAMED VARIABLES 
SAME ( XSAME). 

»*****••»•*»••**•••*••*•*»*• 

« 2. INPUT-OUTPUT PROGRAMS » 
*#*»*#»»»*»»#»*»»#♦*#»»*»»»# 



FOR BCD INPUT TO CORE 

RDATA, REREAD (ENDFIL, EOFSET, 



(TSH), (TSHM)), ZEFBCD (ZEFBINI. 



FOR BINARY INPUT TO CORE 

INDATA, PACDAT, ZEFBCD 



(ZEFBIN). 
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FOR BCD OUTPUT FROM CORE 

COLABL, CSOUT, CVSOUT, DISPLA (DSPL90I, FMTOUT, MLI2A6, MOUT, 

MOUTAI, ONLINE ( (STH), (STHD), CSTHM)), PWMLIV, VECOUT, VOUT, 
VRSOUT, VSOUT. 

FOR BINARY OUTPUT FROM CORE 
OUDATAt WRTDAT. 



FOR GRAPHICAL OUTPUT FROM CORE 



CNTRDB, CNTROW, 
( HST2, HST309, 
(LINV90)t PLOTVS f 



CONTUR, DISPLA 
HST390), LINE 
PLTVS1. 



(DSPL90), GRAPH, GRAPHX, HSTPLT 
(LINE90), LINEH (LINH90), LINEV 



FOR FORMAT PURPOSES 

COLABL, DSPFMT, FNDFMT, RPLFMT. 



* 3. DATA TRANSMISSION * 

* AND ACCESS PROGRAMS » 



FOR STORAGE-TO-STORAGE MOVEMENT 

EXCHVS, MOVE, MOVECS, MOVREV, 



MRVRS, MVBLOK. 



FOR STORAGE-TO-TAPE MOVEMENT 
GETRDi, OUDATA, WRTDAT, 

FOR TAPE-TO-STORAGE MOVEMENT 
INDATA, PACDAT. 

FOR TAPE-TO-TAPE MOVEMENT 
CPYFL2, DADECK. 



FOR INFORMATION STORAGE 

OUDATA, PAKN (UNPAKN), SETINO, 



TRMINO, 



WRTDAT. 



FOR INFORMATION RETRIEVAL 

GETX C IGETX), INDATA, 
( PAKN). 



LISTNG, 



NTHA ( XNTHAI, PACDAT, UNPAKN 



»*»»*•»**»•»*•*»**•*•»*••••»•*»»•» 

» 4. DATA FORM-CHANGING PROGRAMS * 
**»»*•*»**••*•••*•*•»*«*••»**«*»•* 



FOR CONVERTING DATA MODE 

FIXV ( FIXVR), FLOATM, FLOATV, FXDATA 
INTHOL, ITOMLI, IVTOHV (HVTOIV), MLI2A6, 



(FLDATA) , HVTOIV 
XFIXM. 



i IVTOHV I, 



FOR PACKING DATA 

PAKN (UNPAKN). 



FOR UNPACKING DATA 
UNPAKN ( PAKN). 



FOR SCALING DATA 

FXDATA (FLDATA), MLISCL, SCPSCL, SMPSON. 
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FOR NORMALIZING DATA 

FXOATA (FLDATAI, NMZMG1, NRMVEC. 

FOR ROUNDING DATA 

FIXV ( FIXVRI, FXDATA (FLDATAI, RND 
( RNDVDNt RNDVUP1, XDIV ( XDIVRJ, XDVIDE 
(XDVRBV). 



( RNDDN, RNDUPI, RNDV 
(XDVIDRf, XFIXM, XVDVBV 



FOR SHIFTING DATA 

HLADJ C HRADJI, ITOMLI, 

FOR CHANGING DATA SPACING 
MOVREV* 



LSHFT (XLSHFT), SHFTR1, SHFTR2. 



*••*•••***«••»»»*«»••»*•«•«•**• 

• 5. DATA GENERATING PROGRAMS ♦ 
»*•****#*»»•**•»•••»*»»»•*•»*•# 

FOR GENERATING HOLLERITH 

GENHOLf GETHOL, GNHOL2. 

FOR GENERATING RANDOM NUMBERS 
GETRD1. 

FOR GENERATING SINUSOIDS 

COSTBL (COSTBX, SINTBL, 

FOR GENERATING SCALARS 

SETK ( SETKSt SETVECI, 



SINTBXI, SEQSAC 
SETK2, SETKP 



(NEXCOS, NEXSIM* 



CSETVCPI, SETKS2. 



FOR GENERATING 1-D ARRAYS 

SETK ( SETKS, SETVEC), SETKP 
(XSTLINI, SETLNS, STZ, STZS, 

»«#**••»»**»••»*»••«»*»»*»»• 

• 6. DATA INQUIRY PROGRAMS * 
»*»»•»•**•***•**••**«»*••«*• 



(SETVCP), SETKVf SETKVS, 5ETLIN 



FOR FINDING EXTREMAL VALUES 
MAXSN C MAXAB, MINAB, 



MINSN) , MAXSNM (MAXABM, MINAB*, MINSNM)« 



FOR COMPARING DATA 

CMPARP CCMPARS), CMPARV (CMPARL), CMPRA 

(CHUSET, SETAPT, SETEST, VINDEX), LIMITS, 

CALL2, RETURN, SETSBV, SETUP, STORE, 

XNAME, XNARGS), XACTEQ, XLIMIT. 



(CMPRFL, XCMPRA), INDEX 
LOCATE ( ARG, CALL, 
WHERE, XARG, XINDEX, 



FOR SEARCHING DATA 

FASCNl, FASTRK, NXALRM, SEARCH, 



FOR SELECTING DATA 

CHOOSE, GETX ( IGETX), 

FOR ORDERING DATA 
SIZEUP (SIZUPLK 



SRCH1. 

NTHA ( XNTHA), WHICH <XWHICH). 



FOR CLASSIFYING DATA 
MONOCK, XOOZE. 
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»»***»»*•**»•••**#****#*»»*»»**•*** 

7. ELEMENTARY NUMERICAL PROGRAMS * 
*»»*•»*•*»*•*•**»**»••*»*»»*»***»•* 



FOR ADDITION 

ADDK ( ADDKSt DIVK, DIVKS, 
XADDK t XADDKS, XDIVK, XDIVKS, 



XSUBK, 
SUM 



XSUBKSI, BOOST (DPRESSt 
( XSUMI, VPLUSV (VMNUSVt 



MULKt 
XDVRK f 
XBOOST, 
XVMNSV, 



MULK2» 
XDVRKS, 



SUBKt 
XMULK, 



XDPRSS) f FAPSUP, 
XVPLSV). 



SUBKS 
XMULKS 
NRMVEC 



FOR SUBTRACTION 

ADDK ( ADDKSt DIVK, DIVKS, MULK, MULK2, SUBK, SUBKS 

XADDK, XADDKS, XDIVK, XDIVKS, XDVRK, XDVRKS, XMULK, XMULKS 

XSUBK, XSUBKSI, BOOST (DPRESS, XBOOST, XDPRSSI, REMAV, VPLUSV 

(VMNUSV, XVMNSV, XVPLSV), XREMAV. 



FOR MULTIPLICATION 

ADDK ( ADDKS, DIVK, DIVKS, MULK, 
XADDK, XADDKS, XDIVK, XOIVKS, XDVRK, 
XSUBK, XSUBKSI, DUBLX < DUBLL, HALVL, 
MULPLY, VTIMSV (XVTMSV). 



MULK2, 
XDVRKS, 



SUBK, 
XMULK, 



HALVXI, MLISCL, 



SUBKS 
XMULKS 
MULK2 



FOR DIVISION 

ADDK ( ADDKS, DIVK, DIVKS, MULK, MULK2, 

XADDK, XADDKS, XDIVK, XDIVKS, XDVRK, XDVRKS, 

XSUBK, XSUBKSI, DIVIDE, DUBLX { DUBLL, HALVL, 

XDIV ( XDIVRI, XDVIDE (XDVIDR), XVDVBV (XOVRBV). 



SUBK, 
XMULK, 



SUBKS 
XMULKS 



HALVXI, VDVBYV 



FOR MODIFYING SIGN 
ABSVAL, CHPRTS 



(RVPRTSI, CHSIGN, MOVREV. 



FOR RAISING TO POWERS 

MVSQAV, POWER (SMPRDV), SQRMLI, 



SQUARE (XSQUAR). 



FOR TAKING ROOTS 
SQROOT, XSQRUT. 



FOR TRIGONOMETRIC FUNCTIONS 
ARCTAN, SEQSAC (NEXCOS, 



NEXSIN). 



FOR COLLAPSING VECTORS 
COLAPS, KOLAPS. 

FOR ROTATING VECTORS 
ROTAT1 • 



FOR REVERSING VECTORS 

CHPRTS (RVPRTSI, MOVREV, 



REVER, REVERS. 



FOR EXCHANGING VECTORS 
EXCHVS. 



FOR REFLECTING VECTORS 
REFLEC URFLECI. 
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» 8. MISCELLANEOUS NUMERICAL PROGRAMS » 
»***»•»»»*•»»•»•*•••••»*»»•••»•»•»••»•» 

FOR INTERPOLATION 

ARBCGL, EXPAND, INTOPR, LINTR1, QINTRI. 

FOR SAMPLE BASE CHANGING 

EXPAND. NURINC, SIFT. 

FOR GENERATING SINUSOIDS 

COSTBL (COSTBX, SINTBL, SINTBX), SEQSAC (NEXCOS, NEXSIN). 

FOR TRIGONOMETRIC FUNCTIONS 

ARCTANt SEQSAC (NEXCOS, NEXSIN). 

FOR TREATING ODD AND EVEN PARTS 

CHPRTS (RVPRTS), SPLIT { REFIT). 

FOR FITTING EQUATIONS TO DATA 

CUFITl, INTOPR, LSLINE, PRBFIT, QUFIT1. 

FOR CONTOURING 

CNTRDB, CONTUR. 

FOR DELTA AND STEP FUNCTIONS 

DELTA ( STEPC, STEPL, STEPR, XDELTA, XSTEPC, XSTEPL, XSTEPRI. 

FOR CONVERTING COMPLEX NUMBERS 
AMPHZ ( REIM). 

FOR MOVING SUMMATION 

BLKSUM, MUVADD, MVINAV, MVNSUM, MVSQAV. 

FOR INVERTING FUNCTIONS 
IFNCTN. 

FOR DOT PRODUCTS 

DOT J, FDOT ( FDOTR>, VOOTV. 

**••*•»•••»**••••••••**«•»•••»•** 

* 9. PROBABILITY AND STATISTICS * 
****»•»#•••»*•*»••*•••»•»*»»*••»* 

FOR FINDING MOMENTS 
POWER (SMPRDV). 

FOR FINDING AVERAGES 

AVRAGE, MVINAV, MVSQAV, REMAV, TAMVL ( TAMVR), XAVRGE (XAVRGR), 
XREMAV. 

FOR FINDING R.M.S. VALUES 
RMSDEV CRMSDAV). 



FOR FINDING SUMS OF SQUARES 
SQRDFR ( SQRDEV) , SQRSUM 



(XSQSUM), XSQDFR 



(XSQDEVK 
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FOR FINDING SUMS OF DIFFERENCES 

SQRDFR (SQRDEVI, SUMDFR ( SUMDEVt XSMOEV, XSMDFRI t XSQDFR (XSQDEVI, 

FOR GENERATING RANDOM NUMBERS 
GETRD1. 

FOR RANDOMIZING DATA 
SHUFFL. 

FOR FINDING DISTRIBUTIONS 

FRQCT1, FRQCT2» POKCTi, PRBFIT, PROB2. 

FOR PROBABILITY TRANSFORMATION 

GRUP2, MPSEQ1, NOINTi (NOINT2). 

FOR CHI-SQUARE ANALYSIS 
CHISQR, KIINT1. 

FOR DEPENDENCY TESTING 
MSCONlt POKCTI* 

FOR NORMAL CURVE INTEGRATION 
NOINTI (NOINT2). 

»**•*•••»**•••»•»«***•*«**•»•»*• 

* 10. INTEGRATION AND » 
» DIFFERENTIATION PROGRAMS * 
»*»*•*******••••**•*•#»*•**••**• 

FOR DEFINITE INTEGRATION 

MVNTIN (MVNTNA), SMPSON, TINGL CTINGLA). 

FOR INDEFINITE INTEGRATION 

IDERIV (DERIVA), INTGRA (IINTGR), TAMVL ( TAMVR1 • 

FOR DIFFERENTIATION 

DERIVA (IDERIV*, I INTGR (INTGRA). 

FOR INDEFINITE SUMMATION 

INTSUM (DIFPRS, XNTSUM). 

FOR DIFFERENCING 

DIFPRS ( INTSUM, XDFPRS ) • 

**•*•»*••*•«*»•*•»••••««•*»»*»»**»»»•*»« 

* 11. 2-D ARRAY AND 3-D ARRAY PROGRAMS * 
*»**»•»«•«•*•»*••»»•»•**»**»*»»»»•*»*»•» 

FOR MATRIX MULTIPLICATION 
MATML1, MATML3. 

FOR MATRIX INVERSION 

MAT INV, SIMEQ ( DETRM). 



FOR SOLVING MATRIX EQUATIONS 

LSSSi, RLSPR, RLSSR, SIMEQ ( DETRM), WLLSFP. 
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FOR DETERMINANT EVALUATION 
SIMEQ i DETRMJ. 

FOR MATRIX TRANSPOSITION 
MATRAf MATRA1. 

FOR MATRIX FACTORIZATION 
MFACT. 

FOR 2-D ARRAY ROTATION 
ROAR2. 

FOR INTERPOLATING 2-D ARRAY COLUMNS 
ARBCOL. 

FOR 2-D ARRAY DOT PRODUCTS 
DOTP. 

FOR 2-D ARRAY CORRELATIONS 
SPC0R2. 

FOR 2-D ARRAY FOURIER TRANSFORMATION 
PLANSP. 

FOR SOLVING 2-D ARRAY EQUATIONS 
FIRE2, RLSPR2. 

FOR MATRIX VECTOR REVERSAL 
MRVRS. 

FOR MATRIX VECTOR DOT PRODUCT 
MDOTt MD0T3. 

FOR MATRIX VECTOR CORRELATION 
CRSVM. 

FOR SOLVING MATRIX VECTOR EQUATIONS 
MIFLS, MIPLS, MISS. 

**•*•*••*«»«•*»*»•••»*•*•*• 

» 12. POLYNOMIAL PROGRAMS * 



FOR POLYNOMIAL EVALUATION 
FASCUB, IPLYEVt POLYEV. 

FOR FINDING POLYNOMIAL ROOTS 
MULLER. 

FOR POLYNOMIAL MULTIPLICATION 
CONVLVt CNVLV2. 

FOR POLYNOMIAL DIVISION 
POLYDV. 



PROGRAMS SORTED BY FUNCTION 



FOR POLYNOMIAL SQUARE ROOTS 
PSQRT. 

FOR SYNTHESIZING POLYNOMIALS 
PLYSYNt POLYSN. 



* 13. CORRELATIONS AND CONVOLUTIONS * 
•*»••*»»»»•••*»***••••*»**•»***•••*•• 

FOR AUTOCORRELATION 

CROSS, CROST, PROCOR (FASCOR, FASCR1 , 
QXCORR, WAC. 

FOR CROSS-CORRELATION 

CROSS, CROST, PROCOR ( FASCOR, FASCRl, 
QXCOR1. 

FOR CONVOLUTION 

CONVLV, CNVLV2, QCNVLV. 



FASEPC, FASEPU, QACORR, 



FASEPC, FASEP1I, QXCORR, 



FOR DOT PRODUCTS 

DOTJ, FOOT 



( FDOTR), VDOTV. 



•*»*»•**»**••»»»*«•••»*•*•* 
* 14. HARMONIC TRANSFORMS * 
»»»•»•»»»•**•»••••**»••**•» 

FOR COSINE TRANSFORMATION 
ASPECT, ASPEC2, COSIS1, 

FOR SINE TRANSFORMATION 

COSIS1, COSP (COSISP, 

FOR FOURIER TRANSFORMATION 
COSIS1, COSP (COSISP, 
XSPECT. 



COSP (COSISP, SISP). 
SISP). 

SISP>, FT24 (FT24II), QFURRY (QIFURY)» 



FOR INVERSE FOURIER TRANSFORMATION 
QIFURY ( QFURRY I • 



**»**••«••••»***»*••***••«*»•• 

• 15. MISCELLANEOUS SPECTRAL • 
» ANALYSIS PROGRAMS * 



FOR DANIELL WEIGHTING 

ADANL ( ADANX, XDANL, XDANX). 

FOR SPECTRAL FACTORIZATION 
FACTOR. 



FOR GENERATING NUMERICAL 
GNFLT1. 



FILTERS 



PROGRAMS SORTED BY FUNCTION 



FOR CONVERTING TO AMPLITUDE AND PHASE 
AMPHZ ( REIM ) • 

FOR CONVERTING TO REAL AND IMAGINARY 
AMPHZ ( REIMI. 

FOR SPECTRAL COMPARISONS 
MXRARE. 

FOR GENERATING SINUSOIDS 

COSTBL tCOSTBX, SINTBLt SINTBX*, SEQSAC CNEXCOS» NEXSIN). 



PROGRAMS SORTED BY NON-FUNCTIONAL ATTRIBUTES 



»•••«•»*»••»•* 

* AUTHORSHIP * 
••****••»*»•*• 



CLAERBOUTt JON F. 

ADANL ( AOANXt 

ICOSTBX, SINTBLt 

MI NAB, MINSN), 

SAME ( XSAMEt, 



XDANL t XDANXJ, AMPHZ { REIM), CCNVLV, CGSTBL 

SINTBX), FAPSUM, FSKIP, INDATA, MAXSN C MAX AB , 

MOVE t OUDATA, PAKN (UNPAKN), POLYEVt PSQRT, 

STZ, UNPAKN ( PAKN I , VARARG, WAC. 



CLARK, JACQUELINE 
COLAPS, KOLAPS. 



GALBRAITH, 
CHISQR, 
LINEH 
PROB2, 



JAMES N., 
FACTOR, 

(LINH90), 
SMPSON, 



JR. 

FRQCT2, 
LINH90, 
ZEFBCD 



GRUP2, HSTPLT ( HST2, HST309, HST390), 
LINEV (LINV90), LINV90, MPSEQl, MSCONi, 
(ZEFBIN). 



GREENFIELD, ROY J. 
PRBFIT. 



HANSON, I • 
MULLER. 



M.I.T. COMPUTATION CENTER STAFF 
FRAM90. 



PAN, CHEH 

FT24 (FT24III. 



PROCITO, JOSEPH T. 
QINTR1. 



ROBINSON, ENDERS A. 
PLYSYN. 



SIMPSON, STEPHEN M., JR. 



ABSVAL, 


ADDK 


( ADDKS, 


DIVK, 


DIVKS, 


MULK, 


MULK2, 


SUBK, 


SUBKS, 


XADDK, 


XADDKS, 


XDIVK, 


XDIVKS, 


XDVRK, 


XDVRKS, 


XMU1K, 


XMULKS, 


XSUBK, 


XSUBKS), 


ARBCOL, 


ASPECT, 


ASPEC2, 


AVRAGE, 


BLKSUM, 


BOOST 


(DPRESS, 


XBOOST, 


XDPRSS1, 


CAR IGE, 


CHOOSE, 


CHPRTS 


(RVPRTS), 


CHSIGN, 


CLOCKl, 


CMPARP 


(CMPARS), 


CMPARV 


CCMPARL), 


CNTRDB, 


CNTRCW, 


COLABL, 


CONTUR, 


COSP 


(COSISP, 


SISP), 


CUFIT1, 


CVSOUT, 


DELTA 


{ STEPC, 


STEPL, 


STEPR, 


XDELTA, 


XSTEPC, 


XSTEPL, 


XSTEPR) 


, DERI VA 


(IDERIVI, 


DIFPRS 


{ INTSUM, 


XDFPRSI, 


DIVIDE, 


DSPFMT, 


DUBLX 


I DUBLL , 


HALVL, 


HALVX), 


EXCHVS, 


EXPAND, 


FASCN1, 


FASCUB, 


FASTRK, 


FIXV 


( FIXVR), 


FLOATM, 


FLOATV, 


FMTOUT, 


FNDFMT, 


FRQCTl, 


FXDATA 


( FLDATA } , 


GETHOL, 


GETRD1 , 


GNFLT1, 


GRAPH, 


GRAPHX, 


HLADJ 


( HRADJ) 


, HVTOIV 


(IVTOHVI, 


IDERIV 


(DERIVA), 


IFNCTN, 


IINTGR 


( INTGRA 1, 


INDEX 


CCHUSET, 


SETAPT, 


SETEST, 


VINDEX), 


INTGRA 


(IINTGR) , 


INTOPR, 


INTSUM 


COIFPRS, 


XNTSUM1, 


ITOMLI, 


IVTOHV 


(HVTOIV), 


IXCARG, 


KIINTL, 


LIMITS, 


LINE 


(LINE90), 


LINE90, 


LINTR1, 


LOCATE 


( ARG, 


CALL, 


CALL2, 


RETURN, 


SETSBV, 


SETUP, 


STORE, 


WHERE, 


XARG, 


XINDEX, 


XNAME, 


XNARGS ) , 


MAXSNM 


(MAXABM, 


MINABM, 


MINSNM) , 


MEMUSE, 


MLISCL, 


MLI2A6, 


WONOCK, 



(CONTINUED NEXT PAGE) 



PROGRAMS SORTED BY NON-FUNCTIONAL ATTRIBUTES 



MQUTAI 9 


MOVECSt 


MULK2, 


MULPLY, 


MUVADD, 


MVBLOK, 


■mm 


MVINAV, 


WVNSUM, 


MVNTIN 


(MVNTNA \ , 


MVSQAV, 


MXRARE, 


NTHA 


( XNTHA) 


9 


NURINC, 


NXALRMt 


PLOTVSt 


PLTVSlt 


PLURNS, 


POKCT1, 


POWER 


(SMPRDV) 


t 


PROCOR 


CFASCOR, 


FASCRlt 


FASEPC, 


FASEP1 ) t 


PWMLIV, 


QACORR, 


QCNVLV, 




QFURRY 


IQIFURY) 


QIFURY 


(QFURRY) t 


QUFITl, 


QXCORR, 


REFLEC 


(XRFLECI 


t 


REMAV, 


REVER, 


RMSOEV 


(RMSOAVIt 


RNDV 


(RNDVDN, 


RNDVUP) 


, RPLFMT, 




SCPSCL, 


SEQSAC 


(NEXCOSt 


NEXSIN) » 


SETINO, 


SETK 


I SETKS, 


SETVEC) 


t 


SETK2, 


SETKP 


(SETVCPJ , 


SETKS2, 


SETKV, 


SETKVS, 


SETLIN 


CXSTLIN) 


t 


SETLNS, 


SEVRAL 


( PLURAL 1 , 


SHFTR1 » 


SHUFFL, 


SIFT, 


SPLIT 


( REFIT! 


f 


SQRDFR 


{ SQRDEV ) 


SQRMLIt 


SQROOT, 


SQRSUM 


{ XSQSUM) , 


SQUARE 


(XSQUARI 




STZS, 


SUM 


( XSUM), 


SUMDFR 


CSUMDEV, 


XSMDEV, 


XSMDFRI 


, SWITCH, 




TAMVL 


( TAMVR) 


TINGL 


ITINGLA), 


TRMINO, 


VDOTV, 


VDV8YV, 


VECOUT, 




VOUT, 


VPLUSV 


CVMNUSV, 


XVMNSV, 


XVPLSV), 


VRSOUT, 


VSOUT, 


VTIMSV 




(XVTMSVI , 


WHICH 


(XWHICH), 


XACTEQt 


XAVRGE 


CXAVRGR), 


XDIV 


( XDIVRJ 


t 


XOVIDE 


CXDVIDRI 


XFIXM, 


XLIMIT, 


XLOCV, 


XOOZE, 


XREMAV, 


XSPECT, 




XSQDFR 


(XSQDEV) 


XSQRUT, 


XVDVBV 


(XVDRBV) . 














WIGGINS, RALPH A* 
















ARCTAN, 


CLKON, 


CMPRA 


(CMPRFL, 


XCMPRA J 


, COSIS1, 




CPYFL2, 


CROSS, 


CROST, 


CRSVM, 


CSOUT, 


DOT J, 


DOTP, 


FOOT 




C FDOTRI, 


FIRE2 , 


FRAME 


( FRAM90 } , 


FT24II, 


GENHOL, 


GETX 


( IGETXI 


t 


GNHOL2, 


HST2, 


HST309, 


HST390, 


INTHOL, 


IPLYEV, 


LISTNG, 


LOC, 




LSHFT 


C XLSHFT ) 


LSLINE, 


LSSS1, 


MATINV, 


MATML1, 


MATML3, 


MATRA1 , 




MDOT, 


MDOT3, 


MFACT, 


MIFLSt 


MIPLS, 


MISS, 


MOUT, 


MOVREV, 




MRVRS, 


NMZMG1 , 


NRMVECt 


ONLINE 


( { STH ) , 


{ STHD ) , 


(STHMII 


, PACDAT, 




PLANSP, 


POLYSN, 


QXCORl, 


ROATA, 


REREAD 


(ENDFIL, 


EOF SET, 


( TSH) , 




CTSHMII, 


REVERS, 


RLSPR, 


RLSPR2, 


RLSSR, 


RND 


( RNDDN, 


RNDUP ) 


t 


ROAR2, 


RSKIP, 


SEARCH, 


SPCOR2, 


SRCHi, 


WLLSFP, 


WRTDAT, 


XLCOMN. 








CLAERBOUT, 


J.F., ANO 


WIGGINS, 


R.A. 












CNVLV2, 


POLYDV. 
















GALBRA ITH, 


J.N., ANO 


WIGGINS, 


R.A. 












DADECK. 


















MIT LINCOLN 


LAB, MODIFIED BY 


GALBRAITH 


, J.N. 











DISPLA (DSPL90). 



WIGGINS, R.A., AND SIMPSON, S.M. 
MATRA, SIZEUP (SIZUPL). 

SIMPSON, S.M., AND GALBRAITH, J.N. 
NOINT1 (NOINT2J. 

WIGGINS, R.A., AND CLARK, J. 
ROTAT1. 

SIMPSON, S.M., AND WIGGINS, R.A. 

SHFTR2, TIMA28, TIMSUB (INTMSB). 

OLSZTYN, J.T., MODIFIED BY NEILL, A.M., AND BY WIGGINS, R.A. 
SIMEQ C DETRM). 



PROGRAMS SORTEO BY NON-FUNCTIONAL ATTRIBUTES 



• LANGUAGE COMMENTS * 



FORTRAN 



CARIGEt 


CHISQR, 


CLKONt 


CNTROB, 


COSISi, 


CROSS, 


CROST, 


CRSVM, 


FRQCT1, 


FT24II, 


GETHQL, 


GETRDl, 


INDATAt 


IPLYEV, 


IXCARG, 


KIINT1, 


MAT INVt 


MATML3, 


MDOTt 


M0OT3, 


MlSSt 


MOUTt 


MOUTAI, 


MRVRS, 


MVSQAVf 


MXRARE, 


NRMVEC, 


NXALRM, 


PLYSYN, 


POKCT1, 


POLYDV, 


POLYEV, 


PWMLIV, 


QACORRt 


QCNVLV, 


QFURRY 


QXCQRRf 


QXCOR1, 


RDATA, 


RLSPR? 


SETK2, 


SETKS2, 


SHUFFL, 


SMPSON, 


VOUT, 


WAC, 


WLLSFP, 


XSPECT. 



CNTROW, 


COLABLt 


CCNTUR, 


CONVLV 


DADECK, 


OCTP, 


FIRE2, 


FMTOUT 


GNFLT1, 


GRAPH, 


GRAPHX, 


GRUP2 


LINTR1, 


LISTNG, 


LSLINE, 


LSSSl 


MEMUSE, 


MFACT, 


MIFLS, 


MIPLS 


MSCON1, 


MULK2, 


MULLER, 


MVINAV 


OUDATA, 


PLANSP, 


PLOTVS, 


PLTVSl 


POLYSN, 


PRBFIT, 


PROB2, 


PSQRT 


(QIFURY) , 


QIFURY 


(QFURRY) , 


QINTRl 


RLSPR2t 


RLSSR, 


ROAR2, 


SETIKG 


SPCOR2, 


SRCH1, 


TRMINC, 


VECOUT 



FAP BY OPTION 



ABSVAL, 


ADANL 


( ADANX, 


XDANL, 


ARCTAN, 


ASPEC2, 


AVRAGE, 


BLKSUM, 


CHPRTS 


(RVPRTS), 


CHSIGN, 


CMPARV 


COLAPS, 


CNVLV2, 


COSP 


(COSISP, 


SINTBX), 


CUFIT1, 


OELTA 


( STEPC, 


XSTEPL, 


XSTEPR), 


OERIVA 


CIDERIV), 


DOT J, 


DSPFMT, 


DUBLX 


( DUBLL, 


FACTOR, 


FASCN1, 


FASCUB, 


FASTRK, 


FLOATM, 


FLOATV, 


FRQCT2, 


FT24 


IINTGR 


( INTGRA), 


INDEX 


(CHUSET, 


INTGRA 


(IINTGR), 


INTOPR, 


INTSUM 


MATRA, 


MATRA1, 


MAXSN 


( MAXAB, 


MINABMt 


MINSNM), 


MONOCK, 


MOVE, 


MVBLOKt 


MVNSUM, 


MVNTIN 


(MVNTNA) , 


ONLINE 


( (STH), 


(STHD), 


( STHM ) ) , 


QUFIT1, 


REFLEC 


(XRFLEC), 


REMAV, 


RND 


( RNDON, 


RNDUP), 


RNDV 


XSAME) , 


SCPSCL, 


SEARCH, 


SEQSAC 


XSTLIN), 


SIFT, 


SIMEQ 


( DETRM), 


SQRDFR 


(SQRDEV), 


SQRMLI, 


SQROOT, 


STZ, 


SUM 


( XSUM), 


SUMDFR 


TAMVR), 


TINGL 


(TINGLA), 


VDOTV, 


XVPLSV) , 


VTIMSV 


(XVTMSV), 


WHICH 


XOVIDE 


CXOVIOR), 


XREMAV, 


XSQDFR 



XDANXI 


, AMPHZ 


( RE I Ml 


, ARBCGL , 


BOOST 


(DPRESS, 


XBCOST, 


XOPRSS), 


(CMPARL) 


, CMPRA 


(CMPRFL, 


XCMPRA), 


SISP) 


, COSTBL 


(CCSTBX, 


SINT8L, 


STEPL, 


STEPR, 


XDELTA, 


SCSTEPC, 


DIFPRS 


( INTSUM, 


XDFPRS) 


, DIVIDE, 


HALVL, 


HALVX), 


EXCHVS, 


EXPAND, 


FOOT 


( FDOTR), 


FIXV 


( FIXVR), 


(FT241I) 


, IDERIV 


(DERI VA) 


, IFNCTN, 


SETAPT, 


SETEST, 


VINDEX) 


, INTHGL, 


(DIFPRS, 


XNTSUM), 


KCLAPS, 


MATML1, 


MINABt 


MINSN), 


MAXSNM 


( MAXABM t 


MOVREV, 


MPSEQ1, 


MULPLY, 


MUVACD, 


NMZMGlt 


NOINTl 


(NCINT2I 


» NURINC, 


PAKN 


(UNPAKN), 


POWER 


(SMPRDV), 


REVER, 


REVERS, 


RMSDEV 


(RMSDAV), 


(RNDVDN, 


RNDVUP), 


ROTAT1, 


SAME 


(NEXCOS, 


NEXSIN), 


SETKV, 


SETLIN 


SIZEUP 


(SIZUPL), 


SPLIT 


( REFIT), 


SQRSUM 


(XSQSUM), 


SQUARE 


(XSQUAR), 


(SUMDEV, 


XSMDEV, 


XSMDFR) 


, TAMVL 


VDV8YV, 


VPLUSV 


(VMNUSV, 


XVMNSV, 


(XWHICH) 


, WRTDAT, 


XAVRGE 


(XAVRGR), 


(XSQDEV) 


, XSQRUT, 


XVDVBV 


(XVDRBV). 



FAP NECESS 


ARILY 






ADDK 


( ADDKS, 


DIVK, 


DIVKS, 


XADDK, 


XADDKS, 


XDIVK, 


XDIVKS, 


XSUBK, 


XSUBKSI, 


CHOOSE, 


CLOCK! , 


CVSOUT, 


DISPLA 


(DSPL90), 


DSPL90, 


FRAM90, 


FSKIP, 


FXDATA 


(FLDATA), 


HLADJ 


( HRADJ ) , 


HSTPLT 


( HST2, 


HST390, 


HVTOIV 


( IVTOHV), 


ITOMLI, 


(LINE90) 


, LINE90, 


LINEH 


(LINH90), 


LOC, 


LOCATE 


( ARG, 


CALL, 


STORE, 


WHERE, 


XARG, 


XINDEX, 


MLISCL, 


MLI2A6, 


MOVECS, 


NTHA 



MULK, 


MULK2, 


SUBK, 


SUBKS, 


XDVRK, 


XDVRKS, 


XMULK, 


XMULKS, 


CMPARP 


(CMPARS), 


CPYFL2, 


CSOUT, 


FAPSUM, 


FNDFMT, 


FRAME 


(FRAM90), 


GENHOL, 


GETX 


( IGETX) 


, GNHOL2, 


HST309, 


HST390), 


HST2, 


HST3C9, 


IVTOHV 


(HVTOIV), 


LIMITS, 


LINE 


LINH90, 


LINEV 


(LINV90) 


, LINV90, 


CALL2, 


RETURN, 


SETSBV, 


SETUP, 


XNAME , 


XNARGS), 


LSHFT 


(XLSHFT), 


XNTHA) 


, PACDAT, 


PLURNS, 


PROCOR 



(CONTINUED N£XT PAGE) 



PROGRAMS SORTED BY NON-FUNCTIONAL ATTRIBUTES 



(FASCOR, FASCR1, FASEPC, FASEP1), REREAD (ENDFIL, ECFSET, CTSH), 



(TSHMUt RPLFMT, RSKIP, 
SETKVS, SETLNS, SEVRAL 
TIMA2B, TIMSUB ( INTMSB) i UNPAKN 
XACTEQt XDIV ( XDIVR), XFIXM, 
ZEFBCD (ZEFBINK 



SETK ( SETKSt 
( PLURAL ) t SHFTR1, 
( PAKN) 
XLCOMN, 



SETVEC), 
SHFTR2 1 
, VARARGt VRSOUT, 
XLIMIT, XLOCV, 



SETKP (SETVCPJ 
STZS, SWITCH, 
VSOUT, 
XOOZEt 



SUBROUTINE 
ABSVAL, 
DIVKS, 
XDIVKSt 
( REIM) 
XBOOST, 
CLKONt 
COLABL, 
SISP) 
CRSVM, 
(INTSUM, 
DSPFMT, 
FAPSUM, 
{ FIXVR) 
FRQCT2, 
GETHOL, 
( HST2, 
IDERIV 
INTHOL, 
(HVTOIV) 
LINEH 

LOC, 
STORE, 
MAT INV, 
MINSN) 
MFACT, 
MOUTAI, 
MULLER, 
MVSQAV, 
ONLINE 
PLANSP, 

POWER 
FASEP1) 
(QFURRY) 
REMAV, 
RLSPR, 
ROAR2, 
NEXSIN) 
SETKS2, 
SHFTR1, 
SMPSON, 
SQRSUM 
( XSUM) 
TIMSUB 

VDOTV, 
VRSOUT, 
(XAVRGR) 
(XSQDEV1 



SUBPROGRAM 
ADANL ( 

MULK, 
XDVRK, 
, ARBCOL, 
XDPRSS), 
CLOCK1, 
COLAPS, 
, COSTBL ( 
CSOUT, 
XDFPRS), 

DUBLX C 
FASCN1, 
, FLOATV, 
FSKIP, 
GETRD1, 
HST309, 
(DERIVA), 
INTOPR, 
, IXCARG, 
(LINH9Q), 
LOCATE ( 

WHERE, 
MATMLl, 
, MAXSNM ( 
MIFLS, 
MOVE, 
MULPLY, 
MXRARE, 
( ( STH) , 
PLOTVS, 
(SMPRDV), 
, PSQRT, 
, QINTR1, 
REREAD { 
RLSPR2, 
ROTAT1 , 
, SETINO, 
SETKV, 
SHFTR2, 
SPCOR2, 
(XSQSUM), 
, SUMDFR ( 
(INTMSB), 
VDVBYV, 
VSOUT, 
, XDVIDE { 
, XSQRUT, 



ADANX, 

MULK2, 
XDVRKS, 
ASPECT, 
CARIGE, 
CMPARP 
CONTUR, 
COSTBX, 
CUFIT1, 
DISPLA 

DUBLL, 
FASCUB, 
FMTOUT, 

FT24 
GNFLT1, 
HST390), 
IFNCTN, 
INTSUM 
KIINT1, 
LINH90I, 
ARG, 
XARG, 
MATML3, 
MAXABM, 

MIPLS, 
MOVECS, 
MUVADD, 
NMZMG1, 
(STHD), 
PLTVS1, 
PRBFIT, 
PWMLIV, 
0UFIT1, 
ENDFIL, 

RLSSR, 
RPLFMT, 

SETK 
SETKVS, 
SHUFFL, 

SPLIT 
SQUARE 
SUMDEV, 

TINGL 
VECOUT, 
VTIMSV 
XDVIDR), 
XVDVBV 



XDANL, 
SUBK, 
XMULK, 
ASPEC2, 
CHISQR, 
(CMPARS), 
CONVLV, 
SINTBL, 
CVSOUT, 
(DSPL90), 
HALVL, 
FASTRK, 
FNDFMT, 
(FT24II), 
GNHOL2, 
HST2, 
IINTGR 
(DIFPRS, 
KOLAPS, 
LINEV 
CALL, 
XINDEX, 
MATRA, 
MINA8M, 
MISS, 
MOVREV, 
MVBLOK, 
NOINT1 
( STHM) ) , 
PLURNS, 
PROB2, 
QACORR, 
QXCORR, 
EOFSET, 
RMSDEV 
RSKIP, 
( SETKS, 
SETLIN 
SIFT, 
( REFIT), 
(XSQUAR), 

XSMDEV, 
(TINGLA), 

VOUT, 
(XVTMSV), 

XLIMIT, 
( XVDRBV I • 



XDANX3 

SUBKS, 
XMULKS, 
AVRAGE, 
CHOOSE, 
CMPARV 
CNVLV2, 
SINTBX) 
DADECK, 
DSPL90, 

HALVXI 
FOOT 

FRAME 
FT24II 

GRAPH 
HST309 
CINTGRA 
XNTSUM 
LIMITS 
(LINV90 

CALL2 

XNAME 
MATRA1 
MINSNM 
MLISCL 
MPSEQ1 
MVINAV 
(NOINT2 
OUDATA 
PLYSYN 
PROCOR 
QCNVLV 
QXCORl 

(TSH) 
(RMSDAV 
SCPSCL 
SETVEC 
(XSTLIN 

SIMEQ 
SQRDFR 

SRCH1, 
XSMDFR) 
TRMINO, 
VPLUSV 
WAC, 

XLOCV, 



, ADDK 
XADDK, 
XSUBK, 
BLKSUM , 
CHPRTS 
( CMPARL ) , 
COSISl, 
, CPYFL2, 
DERIVA 
DIVIDE, 
, EXCHVS, 
{ FDOTR), 
CFRAM90), 
FXDATA 
GRAPHX, 
HST390, 
, INDATA, 
, IPLYEV, 

LINE 
, LINV90, 
RETURN, 
XNARGS ) , 
MAXSN 
, MOOT, 
MLI2A6, 
MRVRS, 
MVNSUM, 
, NRMVEC, 
PACDAT, 
POKCT1, 
(FASCOR, 
QFURRY 

RDATA, 
(TSHMH, 
, RNDV 

SEARCH, 
, SETK2, 
, SETLNS, 
I DETRMI, 
(SQRDEV), 
STZ, 
, TAMVL 
UNPAKN 
(VMNUSV, 
WLLSFP, 
XREMAV, 



( ADDKS, 
XADDKS, 
XSUBKSI 
BOOST 
(RVPRTS) 
CNTR08, 
COSP 
CROSS, 
(IDERIV* 
DOT J, 
EXPAND, 
FIRE2, 
FRAM90, 
(FLDATA ) 
GRUP2, 
HVTOIV 
INTGRA 
ITOMLI, 
(LINE9C* 
LINTR1, 
SETSBV, 
LSLINE, 
( MAXAB, 
MDOT3, 
MGNOCK, 
MSCON1, 
MVNTIN 
NURINC, 

PAKN 
PCLYDV, 
FASCR1, 
(QIFURY) 
REFLEC 
REVER, 
(RNDVDN, 
SEQSAC 
SETKP 
SEVRAL 
SIZEUP 
SCRML I , 
STZS, 
( TAMVR) 
( PAKN ) 
XVMNSV, 
WRTDAT, 
XSPECT, 



DIVK, 
XDIVK, 
, AMPHZ 

(DPRESS, 
, CHSIGN, 
CNTRCW, 
(CGSISP, 
CRGST, 
, DIFPRS 
DOTP, 
FACTOR, 

FIXV 
FRQCT1, 
, GENHCL , 
HSTPLT 
( IVTOHVI 
(€ INTGR I 
IVTOHV 
, LINE90, 
LISTNG, 
SETUP, 
LSSS1, 
MINAB, 
MEMUSE, 
NOUT, 
MULK2, 
( MVNTNA I 
NXALRM, 
(UNPAKN ) 
PCLYSN, 
FASEPC, 
, QIFURY 
(XRFLEC) 
REVERS, 
RNDVUPI 
(NEXCOS, 
(SETVCP) 
(PLURAL) 
(SIZUPL) 
SCROCT, 
SUM 
, TIMA2B, 
, VARARG, 
XVPLSV) 
XAVRGE 
XSCDFR 



PROGRAMS SORTED BY NON-FUNCTIONAL ATTRIBUTES 



CLOSED FUNCTION 

ARCTAN, CMPRA 
XDELTAt XSTEPC, 
(CHUSET, SETAPT, 
RND ( RNDDNt 
XACTEQt XDIV 
(ZEFBIN). 



(CMPRFL, XCMPRA) 

XSTEPL, XSTEPR) 

SETEST, VINDEX) 

RNDUP), SAME 

( XDIVRI, XFIXM f 



, DELTA C STEPC, 
, FLOATMf HLADJ 
, LSHFT tXLSHFT), 
( XSAME), SWITCH, 
XLCOMN, XL I MIT, 



STEPLt STEPR, 
( HRAOJ), INDEX 
NTH A ( XNTHA), 
WHICH (XWHICH), 
XOOZE, ZEFBCD 



FORTRAN FUNCTION 

GETX ( IGETX). 

MAIN PROGRAM 

(NO ENTRIES FOR THIS CATEGORY) 



••»***»*•*•»•»»»*•»»•••»*»»*»»»• 

• COMMENTS ON LINKAGE, PROGRAM * 

* AFFILIATIONS, AND STORAGE * 
***«*»**•*»»*»*»»•*»*»•*•*•***•» 



MULTIPLE 
ADANL 
MULK 
XDVRK 
BOOST 
CMPARV 
COSTBL 
XDELTA 
( DUBLL 
(FLDATA 
SETEST 
CALL2 
XNAME 
MAXSNM 
NOINT1 
POWER 
(XRFLEC 
RND 
SEQSAC 
SETLIN 
SPLIT 
SUM 
TIMSUB 
VTIMSV 
XDVIDE 



ENTRIES 
( ADANX, 
MULK2, 
XDVRKS, 
(DPRESS, 
(CMPARL), 
(COSTBX, 
XSTEPC, 
HALVL, 
GETX 
VINDEX), 
RETURN, 
XNARGS) , 
(MAXABM, 
(NOINT2), 
(SMPRDV), 

REREAD 
( RNDDN, 
(NEXCOS, 
CXSTLINI, 
C REFIT), 
( XSUM), 
( INTMSB), 
CXVTMSV), 
(XDVIDR), 



XDANL, 
SUBK, 

XMULK, 
XBOOST, 

CMPRA 
SINTBL, 
XSTEPL, 

HALVX) 
( IGETX) 
INTSUM 
SETSBV, 

LSHFT 
MINABM, 

NTHA 
PROCOR 
(ENDFIL, 

RNDUP) 
NEXSIN) 
SEVRAL 
SQRDFR 
SUMDFR 

TINGL 

WHICH 
XSQDFR 



XDANX), 
SUBKS, 
XMULKS, 
XDPRSS) , 
(CMPRFL, 
SINTBX), 
XSTEPR), 
, FDOT 
, HLADJ 
(DIFPRS, 
SETUP, 
( XLSHFT ) , 
MINSNM), 
( XNTHA), 
(FASCOR, 
EOFSET, 
, RNDV 
, SETK 
(PLURAL), 
(SQRDEV), 
(SUMDEV, 
(TINGLA), 
(XWHICH), 
(XSQDEV), 



ADDK 
XADDK, 
XSUBK, 
CHPRTS 
XCMPRA) 

DELTA 
DIFPRS 
( FDOTR) 
( HRADJ) 
XNTSUM) 
STORE, 
MAXSN 
MULPLY 
ONLINE 
FASCR1, 
(TSH) , 
(RNDVDN, 
( SETKS, 
SIMEQ 
SQRSUM 
XSMDEV, 
VPLUSV 
XAVRGE 
XVDVBV 



( ADDKS, 
XADDKS, 
XSUBKS), 
(RVPRTS), 
, COSP 
( STEPC, 
( INTSUM, 
, FIXV 
, INDEX 
, LOCATE 
WHERE, 
( MAXAB , 
( XMLPLY ) i 
( (STH), 
FASEPC, 
(TSHM) ) i 
RNDVUP), 
SETVEC) , 
( DETRM ) i 
(XSQSUM) , 
XSMDFR ) , 
(VMNUSV, 
(XAVRGR)i 
(XVDRBV), 



DIVK, 
XDIVK, 
AMPHZ 
CMPARP 
(CCSISP, 
STEPL, 
XDFPRS), 
( FIXVR), 
(CHUSET, 
( ARG, 
XARG, 
MINAB, 
MVNTIN 
(STHD), 
FASEP1), 
RMSDEV 
SAME 
SETKP 
SIZEUP 
SQUARE 
TAMVL 
XVMNSV, 

XDIV 
ZEFBCC 



DIVHS, 
XDIVKS, 
( REIM), 
(CMPARS), 
SISP), 
STEPR, 
DUBLX 
FXDATA 
SETAPT, 
CALL, 
XINDEX, 
MINSN ) , 
(MVNTNA), 
ISTHMI ), 
REFLEC 
(RMSDAV), 
( XSA*E), 
(SETVCPI, 
(SIZUPL), 
(XSQUAR), 
( TAMVR), 
XVPLSV), 
( XDIVR), 
(ZEFBIN). 



NO ARGUMENTS 

CLKON, DISPLA (DSPL90), FRAME (FRAM90), TIMSUB 
(ENDFIL, EOFSET, (TSH), (TSHM)). 



(INTMSB), REREAD 



INVOLVES NON-STANDARD INFORMATION EXCHANGE 

CLOCK1, DISPLA (DSPL90), DSPL90, GENHOL, INDEX (CHUSET, SETAPT, 



SETEST, VINDEX), LOCATE ( ARG, CALL, CALL2, 

SETUP, STORE, WHERE, XARG, XINDEX, XNAME, 

ONLINE ( (STH), (STHD), ( STHM ) ) , PLURNS, RDATA, 

EOFSET, (TSH), ( TSHM) I , RPLFMT, SEQSAC (NEXCOS, 

(PLURAL), TIMA2B, TIMSUB (INTMSB), VARARG, XLCOMN. 



RETURN, SETSBV, 
XNARGS), MEMUSE, 
REREAD (ENDFIL, 
NEXSIN), SEVRAL 



PROGRAMS SORTED BY NON-FUNCTIONAL ATTRIBUTES 



VARIABLE LENGTH CALLING SEQUENCE 



AODK 


( AODKS, 


OIVK, 


DIVKS, 


MULK, 


MULK2, 


SUBK, 


SUBKS, 


XADDK, 


XADOKS, 


XDIVK, 


XDIVKS, 


XOVRK, 


XDVRKS, 


XMULK, 


XMULKS, 


XSUBKt 


XSUBKS), 


CHOOSE, 


CMPARP 


(CMPARS) , 


CSOUT, 


CVSOUT, 


GETX 


( IGETX) 


, INOATAt 


LIMITS, 


LOCATE 


( ARG, 


CALL, 


CALL2, 


RETURN, 


SETSBV, 


SETUP, 


STORE, 


WHERE, 


XARG, 


XINDEX, 


XNAME, 


XNARGS), 


MOVECS, 


MULK2, 


NTHA 


C XNTHA), 


OUDATA, 


PLTVSi, 


PLURNS, 


RDATA, 


SETK 


( SETKS, 


SETVEC), 


SETK2, 


SETKP 


(SETVCP), 


SETKVS, 


SETLNS, 


SEVRAL 


(PLURAL), 


STZS, 


VRSOUT, 


VSOUT, 


XLOCV. 







USES NO SUBROUTINES 



ABSVAL, 


AODK 


( ADDKS, 


DIVK, 


DIVKS, 


MULK, 


MULK2, 


SUBK , 


SUBKS, 


XADDK, 


XADDKS, 


XDIVK, 


XDIVKS, 


XDVRK, 


XDVRKS, 


XMULK, 


XMULKS, 


XSUBK, 


XSU8KS ) , 


AVRAGE, 


BLKSUM, 


BOOST 


(DPRESS, 


XBCOST, 


XDPRSS ) • 


CHISOR. 


CHOOSE* 


CHPRTS 


(RVPRTS ! • 


CHS IGN. 


CLOCK1 • 


CMPARP 


CMPARS ) , 


CMPARV 


(CMPARL ) • 


CMPRA 


1 CMPRFL. 


XCMPRA) , 


CGLAPS, 


CCNVLV , 


CNVLV2, 


COSP 


( COSI SP. 


SISPI , 


CUFIT1, 


DELTA 


i STEPC, 


STEPL, 


STEPR, 


XDELTA, 


XSTEPC, 


XSTEPL, 


XSTEPR 1 , 


DERIVA 


(IDERIV) , 


DIFPRS 


INTSUM, 


XDFPRS ) , 


DIVIDE, 


DOTJ, 


DSPFMT, 


DUBLX 


( DUBLL, 


HALVX, 


HALVL ) , 


EXCHVS. 


FAPSUM, 


FASCN1, 


FASCUB, 


FASTRK, 


FOOT 


( FDOTR), 


F I XV 


( FIXVR), 


FLOATM, 


FLOATV, 


FRAME 


(FRAM90) , 


FRAM90, 


FRQCT1 , 


FRQCT2, 


FT24I I , 


FXDATA 


(FLDATA) , 


GETX 


( IGETXI, 


GRUP2, 


HLACJ 


HRAOJ) , 


HVTGIV 


CIVTOHV), 


IDERIV 


(DERIVA) , 


IINTGR 


(INTGRA), 


INDEX 


CHUSET, 


SETAPT, 


SETEST, 


VINDEX), 


INTGRA 


(IINTGR), 


INTOPR, 


INTSUM 


DIFPRS, 


XNTSUM), 


ITOMLI, 


IVTOHV 


(HVTGIV) , 


KOLAPS, 


LIMITS, 


LINE 


LINE90), 


LINE90, 


LINEH 


(LINH90), 


LINH90, 


LINEV 


(LINV90), 


LINV90, 


LINTR1, 


LOC, 


LOCATE 


( ARG, 


CALL, 


CALL2, 


RETURN, 


SETSBV, 


SETUP, 


STORE, 


WHERE, 


XARG, 


XINDEX, 


XNAME, 


XNARGS), 


LSHFT 


XLSHFT) , 


LSLINE, 


MATML1, 


MATRA, 


MATRA1, 


MAXSN 


( MAXAB, 


MINAB, 


MINSN) , 


MAXSNM 


(MAXABM, 


MINABM, 


MINSNM) , 


MLISCL, 


MLI2A6, 


MONOCK, 


MOVE t 


MOVREV, 


MPSEQ1, 


MSCON1, 


MULPLY, 


MUVADD, 


MVBLOK, 


MVINAV, 


MVNSUM, 


MVNTIN 


(MVNTNA), 


MVSQAV, 


NMZMG1, 


NTHA 


( XNTHA), 


NURINC, 


PLURNS, 


POLYEV, 


PROB2, 


PROCOR 


(FASCOR, 


FASCR1, 


FASEPC, 


FASEP1), 


QUFIT1, 


REFLEC 


(XRFLEC), 


REMAV, 


REVER, 


REVERS, 


RND 


( RNDDN , 


RNDUP ) 9 


ROTAT1, 


RPLFMT, 


SAME 


C XSAME ) , 


SCPSCL, 


SEARCH, 


SETK 


SETKS, 


SETVEC), 


SETKV, 


SETKVS, 


SETLIN 


(XSTLIN), 


SHFTR1, 


SHFTR2, 


SIFT, 


SIMEQ 


( DETRM), 


SIZEUP 


(SIZUPL) , 


SMPSON, 


SPLIT 


( REFIT), 


SQRDFR 


(SQRDEV), 


SQRMLI, 


SQRSUM 


(XSQSUMI, 


SQUARE 


(XSQUAR), 


STZ, 


STZS, 


SUM 


( XSUM), 


SUMDFR 


CSUMDEV, 


XSMDEV, 


XSMDFR), 


SWITCH, 


TAMVL 


C TAMVR), 


TIMA2B, 


TINGL 


(TINGLA) , 


UNPAKN 


( PAKN) , 


VARARG, 


VDOTV, 


VDVBYV, 


VPLUSV 


(VMNUSV, 


XVMNSV, 


XVPLSVI, 


VTIMSV 


(XVTMSV) , 


WAC, 


WHICH 


(XWHICH), 


XACTEQ, 


XDIV 


{ XDIVR), 


XFIXM, 


XLCOMN, 


XLIMIT, 


XLOCV, 


XOOZE, 


XSQDFR 


(XSQDEV) • 









DEPENDS ON NECESSARILY FAP SUBROUTINES 



CLKON, 


CNTRDB, 


COLABL, 


CONTUR, 


CRSVM, 


DADECK, 


FMTOUT, 


GETRDi, 


GRAPH, 


GRAPHX, 


INDATA, 


INTHOL, 


LISTNG, 


MEMUSE, 


MCUTAI, 


OUDATA, 


PAKN, 


PLANSP, 


PLOTVS, 


PLTVSI, 


PWMLIV, 


QACORR, 


QCNVLV, 


OXCCRR , 


QXCOR1, 


RDATA, 


SETINO, 


SHUFFL, 


SPCOR2, 


SRCH1, 


TRMINC, 


VECOUT, 


VOUT, 


XAVRGE 


( XAVRGR I , 


XDVIDE 


(XDVIDR), 


XREMAV, 


XVDVBV 


(XVDRBV). 



PROGRAMS SORTED BY NON-FUNCTIONAL ATTRIBUTES 



USES ONLY 


FORTRAN SYSTEM ROUTINES 


ADANL 


1 ADANX, 




XDANL, 


XDANX 


SINTBLt 


SINTBX) 


t 


CPYFL2, 


DISPLA 


GNFLT1 f 


GNHOL2, 




IPLYEV, 


IXCARG 


(STHDI , 


(STHMI 1 


, 


PACDAT, 


POWER, 


EOFSET, 


CTSHI, 




CTSHMI), 


RMSDEV 


NEXSIN) 


, SQROOT, 




WRTDAT, 


ZEFBCD 


LESS THAN 


50 REGISTERS 




ARCTANt 


AVRAGE, 




8LKSUM, 


BOOST 


CHOOSE, 


CHSIGN, 




CLKON, 


CMPRA 


( STEPC, 


STEPL, 




STEPR, 


XDELTA 


UNTSUM, 


XDFPRSI 


, 


DIVIDE, 


DUBLX 


FAPSUM, 


FASTRK, 




FDOT 


( FDOTR 


FRAME 


(FRAM90) 




FRAM90, 


GENHOL 


HVTOIV 


CIVTOHVI 


, 


IINTGR 


C INTGRA 


XNTSUMI 


, ITOMLI, 




IXCARG, 


LIMITS 


(LINV90* 


, LINV90, 




LOC, 


LSHFT 


MOVE, 


MOVECS, 




MULPLY, 


MVBLOK 


(XRFLECI 


, REMAV, 




REVER, 


REVERS 


I KNDVDNf 


RNDVUPI 




ROTATl, 


RPLFMT 


SEARCH, 


SETK 




( SETKS, 


SETVEC 


SETLIN 


(XSTLIN) 


t 


SETLNS, 


SIFT 


(XSQSUM) 


, SQUARE 




(XSQUAR), 


STZ 


(SUMDEV, 


XSMDEV, 




XSMOFRt, 


SWITCH 


VOVBYV, 


VPLUSV 




(VMNUSV, 


XVMNSV 


(XVTMSV) 


, WHICH 




(XWHICH), 


XACTEQ 


AUV I Ufc 


(XDVIDR) 


t 


XFIXM, 


XLCOMN 


XSQOFR 


(XSQDEV) 


, 


XSQRUT, 


XVDVBV 


MORE THAN 


500 REGISTERS 




CNTRDB, 


CNTROW, 




CONTUR, 


COSP 


FT24II, 


GRAPH, 




INDATA, 


LISTNG 


RETURN, 


SETSBV, 




SETUP, 


STORE 


XNARGS ) 


, MIPLS, 




MULLER, 


PLANSP 


FASEPC, 


FASEP1) 




CCNVLV, 


QXC0R1 


NEEDS SCRATCH AREA 








ASPECT, 


CNTRD8, 




CNTROW, 


COLABL 


FACTOR, 


GRAPH, 




GRAPHX, 


LISTNG 


PLTVS1, 


PLYSYN, 




POLYSN, 


PRBFIT 


FASEP1I 


, QACORR, 




QCNVLV, 


QFURRY 


QXCOR1, 


RDATA, 




SHUFFL, 


SIMEQ 



XSPECT. 

USES G FORMAT 

CSOUT, RDATA. 

»***»*»»»*•»**•**•»•»*** 

• EQUIPMENT DEALT WITH * 
*****•»****»•»*»»***•»*• 

USES SWITCHES 

CNTRDB, CONTUR, ONLINE C (STH> 
SWITCH. 



I, 


ARCTAN, 


CAR IGE , 


CCSTBL 


(CCSTBX, 




(DSPL90) 


, FSKIP, 


GENHOL, 


GETRDl, 




MULLER, 


MXRARE, 


ONLINE 


( (STH), 




PRBFIT, 


PSQRT, 


REREAD 


(ENOFIL, 




(RMSDAV) 


, RSKIP, 


SEQSAC 


(NEXCCS, 




(ZEFBIN) 


• 








CDPRESS, 


XBOOST, 


XDPRSS), 


CARIGE, 




(CMPRFL, 


XCMPRA) , 


CSOUT, 


DELTA 


, 


XSTEPC, 


XSTEPL, 


XSTEPR), 


DIFPRS 




( DUBLL, 


HALVL, 


HALVXI, 


EXCHVS, 




FIXV 


{ FIXVR), 


FLOAT*, 


FLOATV, 


, 


GETX 


( IGETX ) , 


HLADJ 


( HRADJ ) , 




INTGRA 


(IINTGR I, 


INTSUM 


(DIFPRS, 


, 


LINEH 


(LINH90I, 


LINH90, 


LINEV 




(XLSHFT) 


, MATRA1 , 


MLISCL, 


MONOCK, 




NMZMG1, 


NTHA 


( XNTHA), 


REFLEC 


, 


RND 


( RNDDN, 


RNDUP \ t 


RNDV 


f 


RSKIP, 


SAME 


i XSAMEI, 


SCPSCL, 


1, 


SETKP 


(SETVCP), 


SETKV, 


SETKVS, 




SQRDFR 


( SQRDEV) , 


SCROOT, 


SQRSUM 




STZS, 


SUM 


( XSUM), 


SUMDFR 




TINGL 


(TINGLAI, 


VARARG, 


VDOTV, 




XVPLSV) 


, VRSOUT, 


VSOUT, 


VTIMSV 




XAVRGE 


( XAVRGR ) , 


XDIV 


( XOIVR)* 




XLIMIT, 


XLOCV, 


XOOZE, 


XREMAV, 




(XVDRBVI 


• 








(COSISP, 


SISP), 


FT24 


(FT24II), 


f 


LOCATE 


C ARG, 


CALL, 


CALL2, 


t 


WHERE, 


XARG, 


XINDEX, 


XNA^E y 


f 


PLTVS1, 


PROCOR 


(FASCOR, 


FASCR1, 


t 


RDATA, 


RLSPR2, 


XSPECT. 




t 


CONTUR, 


C0SIS1, 


CPYFL2, 


CVSOUT, 


t 


MAT INV, 


MIFLS, 


MCUTAI, 


PLANSP, 


t 


PROCOR 


t FASCOR, 


FASCR1, 


FASEPC, 




<QIFURY* 


, QIFURY 


(QFURRY), 


QXCORR, 




( DETRM) 


, SPC0R2, 


VRSOUT, 


WLLSFP, 




ISTHO), 


(STHM) ), 


PLOTVS, 


PLTVS1, 



PROGRAMS SORTED BY NON-FUNCTIONAL ATTRIBUTES 



USES KEYS 

(NO ENTRIES FOR THIS CATEGORY) 



USES ONE TAPE 

CAR IGEt CNTROBt COLABlt 

GETROl, MEMUSEt MOUT, 

OUOATA, PACDAT, PLOTVSt 

(TSH), (TSHM)), RSKIP, 

VRSOUT, VSOUT, WRTOAT, 

USES TWO OR MORE TAPES 

CPYFL2» OAOECK, INDATA, 



CONTUR, 
MOUTAI, 
PLTVSl, 
SETINO, 
ZEFBCO 



LISTNGi 



CSOUT, 
ONLINE 
PWMLIV, 
SHUFFL, 
(ZEFBIN) < 



ROATA. 



CVSOUT, FMTOUTt 

( (STH), (STHD), 

REREAD (ENDFIL, 

TRMINO, VECOUT, 



FSKIP, 
ISTHKI), 
€OFSET, 
VOUT, 



USES SCOPE 
DISPLA 
MST309, 



CDSPL90), 
HST390), 



USES INTERVAL TIMER 
CLKON, CLOCK1, 

USES ON-LINE PRINTER 
CLKONt CNTRDBt 
PLTVSl, PWMLIV. 



FRAME 
LINE 



TIMA2B, 
CONTUR, 



( FRAM90 ) , 
UINE90), 



TIMSUB 
ONLINE 



GRAPH, 
LINEH 



C INTMSB) . 
C (STH), 



GRAPHX, HSTPLT 
CLINH90I, LINEV 



( HST2, 
C1INV90I. 



CSTHDIi 



(STHM)), PLCTVS, 



USES OFF-LINE PRINTER 

CAR IGE, CNTRDB, COLABL, 
MOUT, MOUTAI, PLOTVS, 
VSOUT. 



CONTUR, 
PLTVSl, 



CSOUT, 
PWMLIV, 



CVSCUT, FMTOUT, WEMUSE, 



VECOUT, 



VOUT, 



VRSOUT, 



709 ONLY 
DISPLA 
LINEV 



(DSPL90), 
UINV90). 



FRAME CFRAM90), LINE UINE90), LINEH (LINH90), 



7090 AND 7094 ONLY 

DSPL90, FRAM90, LINE90, LINH90, LINV90. 



*•**•»•***»•*»*#»•••••»»»•» 

* ANTITHETICAL SUBJECTIVE * 
» JUDGEMENTS » 



MAJOR 



ASPECT, 


CNTROB, 


CNTROW, 


CONTUR, 


C0SIS1, 


CCSP 


( SISP, 


CGSISP), 


CPYFL2, 


CRSVM, 


DOTP, 


FACTOR, 


FIRE2, 


GRAPH, 


IFNCTN, 


INDATA, 


LOCATE 


{ ARG, 


CALL, 


CALL2, 


RETURN, 


SETSBV, 


SETUP, 


STORE, 


WHERE, 


XARG, 


XINDEX, 


XNAME, 


XNARGS) , 


MATRA, 


MFACT, 


MIFLS, 


MIPLS, 


MISS, 


MSC0N1, 


MULLER, 


MXRARE , 


OUDATA, 


PLANSP, 


PROCCR 


(FASCOR, 


FASCRl, 


FASEPC, 


FASEP1), 


QACORR, 


QCNVLV, 


QFURRY, 


QIFURY, 


QXCORR, 


QXCORI, 


RDATA, 


RLSPR2, 


SEVRAL 


(PLURAL), 


SIMEC 


( DETRM), 


SIZEUP 


(SIZUPL), 


SMPSON, 


SPC0R2, 


TIMA2B, 


TIMSUB 


( INTMSB ) , 


WLLSFP, 


XSPECT. 
















NOR 
















ABSVAL, 


AVRAGE, 


BOOST 


(DPRESS, 


XBOOST, 


XDPRSS), 


CARIGE, 


CHSIGN, 


COLABL, 


DIVIDE, 


DUBLX 


t DUBLL, 


HALVL , 


HALVX), 


FIXV 


( FIXVR), 


FLOATM, 


INDEX 


(CHUSET, 


SETAPT, 


SETEST, 


VINDEX), 


IXC ARG, 


MULPLY, 



(CONTINUED NEXT PAGE) 



PROGRAMS SORTED BY NON-FUNCTIONAL ATTRIBUTES 



POWER (SMPRDV), REFLEC (XRFLEC), RMSDEV ( RMSDAV ) , SCRDFR ( SGRDEV ) 
SQROOT» SQRSUH (XSQSUM), SQUARE (XSQUAR), SUM { XSUM), SUMDFR 

(SUMDEV, XSMDEV, XSMDFR), VDOTV, VDVBYV, VPLUSV (VMNUSV, XVMNSV, 
XVPLSV>, VTIMSV (XVTMSV), XAVRGE (XAVRGR), XDIV ( XDIVR), XDVIOE 

(XDVIDR), XREMAVt XSQDFR (XSQDEV), XSQRUT, XVDV8V (XVORBV). 



OFTEN USED 
ADANL 
CONTUR, 
DADECKt 
HVTOIV 
( MAXABt 
MOUTAI, 
PROCOR 
RND 
SETVEC), 
(SIZUPL), 
VOUT, 
XLIMIT, 



( ADANX, 
COSP 
FMTOUTt 
( IVTOHV), 
MINABt 
MOVE, 
(FASCOR, 
( RNDDNt 
SETKP 
STZ, 
VRSOUT, 
ZEFBCD 



XDANL, 


XDANX) 


C SISP, 


COSISP) 


FSKIP, 


FXDATA 


INDATAt 


IVTOHV 


MINSN), 


MAXSNM 


NTHA 


( XNTHA) 


FASCRlt 


FASEPC, 


RNDUP ) t 


RSKIP, 


(SETVCP), 


SETKV, 


STZS, 


SWITCH, 


VSOUT, 


WAC, 


( ZEFB IN) • 





, AMPHZ 
, COSTBL 
{FLDATA ) 1 
(HVTOIVii 
(MAXABM, 
, OUDATA, 
FASEP1) , 

SAME 
SETKVS, 
TIMSUB 
WHICH 



( REIM), 
(COSTBX, 
GENHOL, 
LIMITS, 
MINABM, 
PAKN 
RDATA, 
( XSAME), 

SETLIN 
( INTMSBI, 
(XWHICH), 



ASPECT, 
SINTBL, 
HLADJ 
MATRA, 
MINSNM) 
( UNPAKN) 
REVER, 
SETK 
(XSTLIN) 
UNPAKN 
XACTEQ, 



CNVLV2, 
SINTBX) 
C HRACJ) 
MAXSN 
, MEMUSE, 
, PLOTVS, 
REVERS, 
( SETKS, 
, SIZEUP 
( PAKN) 
XLCOMN, 



SELDOM USED 

CMPARP (CMPARS), FASCN1, FASTRK, 

REFLEC (XRFLEC), SETK2, SETKS2, 

XAVRGE CXAVRGR), XREMAV, XSQDFR 



GETHOL, MXRARE, NXALRM, PWMLIV, 
SEVRAL (PLURAL), SQRMLI, SQROCT, 
(XSQDEV), XSQRUT, XVDVBV (XVDRBV) 



FAST 



ABSVAL, 


ARBCOL, 


ASPECT, 


BLKSUM, 


CHSIGN, 


CMPARV 


(CMPARL), 


COSIS1, 


COSP 


(COSISP, 


SISP), 


CPYFL2, 


CUFIT1, 


DELTA 


( STEPC, 


STEPL, 


STEPR, 


XDELTA, 


XSTEPC, 


XSTEPL, 


XSTEPR) , 


DERIVA 


(IDERIVI, 


DUBLX 


( DUBLL, 


HALVL, 


HALVX), 


EXCHVS, 


EXPAND, 


FACTOR, 


FAPSUM, 


FASCN1, 


FASCUB, 


FASTRK, 


FDOT 


( FDOTR), 


FIRE2, 


FT24 


(FT24II), 


FT24II, 


HSTPLT 


( HST2, 


HST309, 


HST390), 


HST2, 


HST309, 


HST39C, 


IDERIV 


(DERIVA), 


INTOPR, 


INTSUM 


(DIFPRS, 


XNTSUM) , 


ITOMLI , 


IVTOHV 


(HVTOIV) 


LINE 


(LINE90), 


LINE90, 


LINEH 


(LINH9Q) , 


LINH90, 


LINEV 


(LINV90) 


LINV90, 


MATRA, 


MATRA1, 


MAXSN 


( MAXAB , 


MI NAB, 


MINSN), 


MAXSNM 


(MAXABM, 


MINABM, 


MINSNM), 


MIFLS, 


MIPLS, 


MISS, 


MGNOCK, 


MOVE, 


MOVECS, 


MOVREV, 


MULLER, 


MUVADD, 


MVNSUM, 


MVNTIN 


(MVNTNA), 


NURINC, 


PLANSP, 


PROCOR 


(FASCOR, 


FASCR1, 


FASEPC, 


FASEP1), 


QACORR, 


QCNVLV, 


QFURRY 


(QIFURY), 


QIFURY 


(QFURRY), 


QUFIT1, 


QXCORR, 


QXCOR1, 


REVER, 


REVERS, 


RLSPR, 


RLSPR2, 


RLSSR, 


ROTAT1, 


SAME 


( XSAME), 


SEQSAC 


(NEXCOS, 


NEXSIN), 


SIFT, 


SIZEUP 


(SIZUPL) , 


SPCOR2, 


STZ, 


STZS, 


TAMVL 


( TAMVR), 


TIMA2B, 


TIMSUB 


( INTMSB) , 


TINGL 


(TINGLA), 


UNPAKN 


( PAKN), 


WHICH 


(XWHICH), 


WLLSFP, 


XACTEQ, 


XOOZE, 


XSPECT. 





SLOW 

DSPFMT, GNFLTlt MLI2A6, MULK2. PWMLIV, SRCH1. 



4 

Annotated 

Calling Sequences 



For the working programmer the listings of this section, to which we apply the term 
annotated calling sequences , and the program digests of the next section have proved 
to be the most valuable condensed documentation we have evolved. Both of these forms 
are designed for rapid access to critical program details once an individual has obtained 
general knowledge of a program' sfunctionfrom a study of the complete listing as given 
in Section 10. 

The annotated calling sequences consist of documentation alphabetically ordered 
by names of all entry points, with no distinction made between principal and secondary 
entries. Moreover we have not found it necessary to distinguish between programs of 
identical name, since in all such cases the calling sequences and functional properties 
are practically, if not identically, the same. 

For a given entry the annotated calling sequence has four parts: 

1. a short title, 

2. the entry name, 

3. a parenthetical list of symbols for the arguments of the entry, 

4. an indicator of subprogram type (subroutine subprogram, closed function, 
or FORTRAN function. 

Parts 1 and 3 are not necessarily identical to their counterparts in Section 10. This 

may be slightly confusing. The titles chosen here emphasize the mnemonic significance 

of the entry name and provide some stylistic uniformity. The symbol lists used to Of 

represent the calling sequences have been carefully chosen to convey in six or fewer 

characters maximum information about the nature of the arguments. These choices 

have been made within a fairly uniform notational framework in order to offset the 

parochial fashion in which individual authors assign argument names. A glossary of 

commonly used names and combining forms appears below. The meanings of many 

of the more specialized names can be worked out in the context of the title. For 

example, in 

SRCH1(I1F2B, LV, V, VALUE, INDEX) 

whose title is 

SEARCH VECTOR FOR VALUE BEGINNING AT EITHER END 

the vector searched is V(l. . .LV), the value searched for is VALUE, the index at 
which correspondence is found is INDEX, and I1F2B is a paremeter specifying search 
direction to be read ' 'fixed point 1 if search forward, 2 if backward." 
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Time-Series Computations in FORTRAN and FAP 
COMMONLY USED ARGUMENT NAMES AND COMBINING FORMS 



Form 

ACOR 
ARG 

C, C1,C2, . . . 

COSTAB 

COSTR 

DAN 

DATA 

DUMMY 

ERR or ERROR 

FMT 

FOFIJ 

FREQ, FRQ 

GZF . . . 

HOL 

I . . . 

IANS 

IDIMEN 
IGZF . . . 
ILO, IHI 

ISENSE 
ISPACE 

ITAPE, ITP . . . 

ITPIN, or ITPINP 

ITPOUT 

IX . . , 

IZF . . . 

IZIF . . . 

LAG 

LOCALL 

LX, LY, L . . . 

MDAN 



Interpretation 

Autocorrelation 

Argument 

Scalar constants 

Cosine table 

Cosine transform 

Refers to Daniell spectra 

General (floating-point) vector 

Argument not referred to 

Floating-point error indicator from subroutine 
(=0.0 is normal condition) 

Format 

Matrix FOFIJ(I, J) 
Frequency 

Floating-point quantity with value greater than zero if . . . 
Hollerith vector 

Fixed-point quantity with name . . . 

Fixed-point "answer" from subroutine (IANS=0 is the 
normal condition) 

User's dimension of the subscript I 

Fixed-point quantity with value greater than zero if . . . 

Low and high indices 

Sense switch number 

Scratch area 

Logical tape number 

System-input tape number 

System-output tape number 

Index ... 

Contraction of IZIF . . . 

Fixed-point quantity with value zero if . . . 

Correlation lag 

Machine location of a CALL statement 
Length of vector X, vector Y, or vector . . . 
Daniell weighting parameter 
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Annotated Calling Sequences 

MFREQ Number of frequency intervals in the range 0 to t 

radians 

MLI, MLI . . . Machine-language integers, binary point to right of bit 35 

MXACC Maximum accuracy specification. Input vector will be 

scaled and fixed to integers of maximum magni- 





tude = MXACC 


N . . . 


Fixed-point quantity with interpretation of ' 'number of 


NARGS 


Number of arguments in a CALL statement 


SINTAB 


Sine table 


SINTR 


Sine transform 


SPACE 


Scratch area 


SPECT 


Spectrum 


STOP 


Constant = 777777712345(octal) 


SUBRU 


Name of subroutine in Hollerith 


X, Y 


General floating-point variable or vector 


XCOR 


Cross correlation 


ZIF 


Floating point quantity with value zero if . . . 



Certain program design conventions, which we have adhered to rather closely, 
assist in the immediate interpretation of the annotated calling sequence. These con- 
ventions are: 

1. The normal sequence of arguments in any call statement is 

pure input-type arguments (if any) , 
followed by 

arguments which are both inputs and outputs (if any) , 
followed by 

pure output-type arguments (if any). 

2. The use of arguments which are both inputs and outputs is strongly discouraged, 
most particularly in the case of scalar arguments. 

3. Wherever possible the programs are designed so as to permit the user to equate 
inputs and outputs if he wishes. 

4. The use within a subroutine of 4 'true" DIMENSION statements for arguments in a 
calling sequence is discouraged. Instead the user passes dimension information to 
the subroutine as explicit arguments. 

5. In the case of vectors the normal argument subsequence is 

. . . , vector, length of vector, . . . 
(Note that SRCH1, which was used earlier in an illustration, involves an exception). 
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Time-Series Computations in FORTRAN and FAP 



6. In the case of matrices the normal argument subsequence is 

. . . , matrix, length of column, length of row, dimension in calling program 
of column , . . . 

where a column is defined as the matrix values traversed when the first sub- 
script varies over its domain of definition. 

7. Error flags from subroutines (IANS, ERR, or ERROR) use the value zero to 
indicate the normal or no-error condition. There are no exceptions to this 
convention. 

A word of caution is necessary with respect to some of these entries when one is 
acquiring the programs from the system subroutine library rather than from the input 
deck. The BSS loader scans only the first ten entries of each binary deck (those on 
the program card) of the library file in seeking to satisfy its missing-routines table. 
For programs with more than 10 entries, the eleventh and successive entries are invis- 
ible to the loader. Two programs in the present set fall in this category, LOCATE 
and ADDK. For LOCATE the "invisible" entries are STORE, XNARGS, and XNAME. 
For ADDK they are SUBKS, MULKS, DIVKS, XADDKS, XSUBKS, XMULKS, XDIVKS, 
and XDVRKS. However, no difficulty arises when the input deck refers to one or more 
of these entries provided that it also refers to one or more of the first ten entries (for 
LOCATE these are LOCATE, WHERE, CALL, CALL2, SETSBV, SETUP, RETURN, 
XINDEX, ARG, and XARG; for ADDK they are ADDK, SUBK, MULK, DIVK,XADDK, 
XSUBK, XMULK, XDIVK, XDVRK, and ADDKS) or that such reference develops from 
the routines picked up by the loader. Otherwise, to obtain execution the user must 
either modify his input deck to include this type of reference (i.e., a dummy CALL 
statement) or else add LOCATE or ADDK to his input deck. 



64 



»••**»*••»*•»••»»*»«»••• ANNOTATED CALLING SEQUENCES **»••••»•*•*••**»**••«•• 
♦ ABSVAL TO CNTRDB * * ABSVAL TO CNTROB • 

••*»**«•*••«»***•*»»•*** *»•»•**•*»••«•»••••«•*#• 



AN • F* IN COLUMN «COL A f SIGNIFIES A 'FORTRAN FUNCTION 1 ROUTINE 
AN • F • IN COLUMN 'COL 8 f SIGNIFIES A 'CLOSED FUNCTION* ROUTINE 
OTHERWISE THE ROUTINE IS A 'SUBROUTINE SUBPROGRAM* 



PROGRAM TITLE 



C C 
0 0 
L NAME L 



CALLING SEQUENCE 



B 



ABSOLUTE VALUE OF VECTOR...... 

MODIFY AUTOCORRELATION FOR DANIELL 

SPECTRUM, FLOATING...... 

MODIFY AUTOCORRELATION FOR DANIELL 

SPECTRUM, FIXED 

ADD CONSTANT TO VARIABLES 

ADD CONSTANTS TO VARIABLES 

AMPLITUDE AND PHASE FROM REAL AND 

IMAGINARY PARTS........ 

INTERPOLATE ARBITRARY MATRIX COLUMN... 
ARCTANGENT OF X AND Y 

COORDINATES 

GET SUBROUTINE ARGUMENT. • 

AUTO POWER SPECTRUM FROM CORRELATION.. 



AUTO POWER SPECTRUM FROM CORRELATION.. 

AVERAGE OF A VECTOR 

BLOCK SUMMATION WITH DIVISION......... 

BOOST VECTOR BY A CONSTANT 

PROXY CALL STATEMENT.... 

PROXY CALL STATEMENT USING SUBROUTINE 
VECTOR............ 

OFF-LINE CARRIAGE SPACING 

CHI-SQUARE FOR EQU I-PROBABLE CASE 

CHOOSE BETWEEN TWO LISTS OF 

VARIABLES......... 

CHANGE EVEN AND ODD PARTS... 

CHANGE SIGN BITS OF VECTOR. 

CHOOSE ARGUMENT AND SET IT 

REQUEST OPERATOR TO TURN CLOCK ON 

REAL TIME FROM CLOCK.......... 

COMPARE VECTORS LOGICALLY.. 

COMPARE PAIRS OF VARIABLES....... 

COMPARE A SET OF VARIABLES. 

COMPARE VECTORS WHERE +0 = -0 

ALGEBRAICALLY COMPARE 2 VARIABLES 

ALGEBRAICALLY COMPARE EXPONENT AND 22 

MOST SIGNIFICANT BINARY BITS..... 
CONTOUR MATRIX IN DECIBELS 



ABSVAL ( ANYVEC, ILO, IHI , ABSVEC , I ANS ) 

AD ANL ( ACOR , MXL AG , MDAN ,DACGR ) 

ADANX C I ACOR , MXL AG, MD AN, ID ACOR I 
ADDK (C,Xl,X2,...,XN) 

ADDKS (CI,X1,Y1,C2,X2,Y2,...,CN,XN,YN) 

AMPHZ (REAL, XI MA J, LR XI ,AMP ,PHZ ,ZIFLIM) 
ARBCOL (FOFIJ,LI ,LJ,IDIMEN,FJCOL,COL> 

ARCTANF (X, Y ) 

ARG F CLOCALL,NUMARG, IXVECTI 

ASPECT I ACOR,MXLAG,COSTAB,MFREQ, JMIN, 

JMAX, ZIFXD, SPEC T, SPACE, ISCALE, 

ERR) 

ASPEC2 (ACOR,MXLAG,FREQLO,FRQDEL, 
NFREQS, I ERRLO,SPECT , I ANS ) 
AVRAGE (X,LX,XAVG) 

BLKSUM (X,LX,LBLOK,DVSR,XBSMOD,LXBSGD) 
BOOST (X,LX,XRIZE,XBUSTD> 
CALL ( SUBRU , I ANS , SPACER , ARG1 , ARG2 , 
... ,ARGN) 

CALL2 (SUBRUV,IANS> 
CARIGE <ITAPE,NSPACE) 

CHI SQR INCOUNT, ICOUNT, I SUMC ,CHI SQ, I ANS ) 

CHOOSE (ZIFRST, X,X1,X2, Y,Y1,Y2, 

Z,Z1,Z2) 
CHPRTS (SYM»ANT,N) 
CHSIGN (X,LX,XNEG) 
CHUSETF(X,X1,X2,ZIFX1I 
CLKON 

CL0CK1 (JOB, TIME) 

CMPARL (X, Y,LXY, IGZFEQ) 

CMPARP tIANS,Xl,Yl,X2,Y2,...,XN,YN) 

CMPARS (IANS,Xl,X2,...,XN) 

CMPARV (X, Y,LXY, IGZFEQ) 

CMPRA F(Xi,X2) 

CMPRFLF(X1,X2) 

CNTRDB U TAPE, I SENSE, GZFAMP,VOFXY,LXV, 
LYV,LXDIM,VZ£RO,SPACE,IANS) 



*••»•*•»»•*»••••*»••»«»• 

» CNTROW TO DOTJ * 
**•»•***•»**»*••••»•*«*• 



ANNOTATED CALLING SEQUENCES «*»#»*»»****♦«»«»*»•»*«# 

* CNTRCW TO DOTJ » 
*•**••»•*«•«»••»»«*••••• 



GENERATE HOLLERITH VECTOR FOR ONE 
OUTPUT ROW OF A CONTOUR PLOT. 



LABEL COLUMNS WITH VERTICAL INTEGERS. 



COLLAPSE ONE-SIDED VECTOR 

CONTOUR ARBITRARY RECTANGULAR 
SUBREGION OF A MATRIX,... 



CNTROW (VEC,LVEC,FXLO,FXHI,NCOLS, 
CHLVLSt NCHRStDELEVL tVLEVLt 
SPACE, PLOTVCIANSI 
COLABL (ITAPE,ICCLLC f NCOLLOtNCOLS» 
ISPACE) 

COL APS (X,LX,ZIFXD,XCOLAP,MCQLAPI 

CONTUR CITAPE,ISENSEtVOFXY,LVX f LVY f 

LXDIM,FXLO,FXHI ,NCOLS,NCOLLC, 
FYLOt FYHI 9 NROWSt ARGLOf ARGDELt 
ZFAFXD,CHLVLS »NCHRS »DELEVL, 
VLEVL,SPACE,IANS) 

COMPLETE CONVOLUTION OF TRANSIENTS 

(CCNVLV AND CONVLV- 1 U CONVLV (LX, X,LY, Y,CGNVXYI 

COSINE AND SINE SPECTRUM COSISP (SSX,ASX,SAX,AAX,MXLAG,CCSTA8, 

SINTAB, MFREQ, JM IN, JMAX, Z IFXO, 
COSTR,SINTR) 

COSINE AND/OR SINE SPECTRUM WITH 

SPLITTING • COSIS1 ( I1C2S3,X, LX ,COSTAB , SINTAB , 

MFREQ, JM IN, JMAX, COSTR,SINTR, 
ZIFSTO, SPACE, IANS) 

COSINE SPECTRUM COSP ( SSX ,ASX,MXLAGt COSTABf MFREQt 

JMIN,JMAX,ZIFXD,COSTRI 

COSINE TABLE GENERATION, FLOATING COSTBL (MFREQ, COSTAB ) 

COSINE TABLE GENERATION, FIXED COSTBX (MFREQ , ICOSTB ) 

COPY FILE - TAPE TO TAPE CPYFL2 (ITPIN,ITPOUT,LRECMX, ZFEOFW, 

SPACE, IANS) 

CROSSCORRELATION OF TRANSIENTS 

BEGINNING WITH ZERO LAG. CROSS (LX, X,LY, Y,LC,C) 

CROSSCORRELATION OF TRANSIENTS CROST (LX, X,LY, Y, I LAG,LC,C I 

CROSSCORRELATION OF TRANSIENT VECTORS 

OF MATRICES... CRSVM (NRAC,NCARB,NCBC,LA, AA,LB,BB, 

ZIFNTR,ILAG,LC,CCI 

VARIABLES OUTPUTED FIVE PER LINE CSOUT ( ITAPE,NSPACE,Cl ,C1NAME, 

C2,C2NAME,...,CN,CNNAMEI 

FIT CUBIC TO FOUR DATA VALUES CUFIT1 (FOFX, XLO ,DELX ,CCEFS ) 

COLUMN VECTORS OUTPUTED BY NORMAL 

OR LITERAL FORMATS CVSOUT ( ITAPE,NSPACE,FMTHED ,FMTLIN, ILC, 

IHI,ARGL0,ARGDEL,SPACE,X1,X2, 
...,XN) 

COPY DATA-CARDS DECK ONTO OUTPUT 

TAPE DADECK ( I TP IN , I TPOUT I 

UNIT DELTA FUNCTION DELTA F ( ARG ) 

DERIVATIVE OF A VECTOR...... DERIVA ( YOFX,LY,DELX,DYDX,YOFXl ) 

DETERMINANT OF MATRIX DETRM ( IDIMEN, IJSI ZE , ACF I J ,STHEND, ERR) 

DIFFERENCE A VECTOR BY ELEMENT PAIRS.. DIFPRS ( X,LX, XPRSDF I 
DISPLAY PRINT-TYPE OUTPUT ON SCOPE 

(DISPLA(709) AND DI SPLA ( 7090 ) ) . . . DISPLA ...PRINT FMT ,L I ST. . . FMT FORMAT ( ) 

DIVIDE VECTOR BY A CONSTANT DIVIDE (X,LX, XDVSR, XDVOED) 

DIVIDE VARIABLES BY A CONSTANT DIVK (C , XI , X2 , . . . , XNI 

DIVIDE VARIABLES BY CONSTANTS DIVKS (Cl,Xi,Yl,C2,X2,Y2,...,CN,XN,Yft) 

PSEUDO DO STATEMENT DO SEVRAL ( . . . ,2HD0,NSUBS, I , ILO, 

IHI,...) 

DOT PRODUCT WITH JUMPED SUBSCRIPTS.... DOTJ (LXY, JUMPX, X, JUMPY, Y,DOTXY, 

GZF ADD,GZFSMD1 



****»»•*»•*»••*•••*«»»*» ANNOTATED 
* DOTP TO GNFLT1 • 
•»*••*»»•••»»*••»*•*»••» 



DISPLACED DOT PRODUCT OF 

2 DIMENSIONAL ARRAYS 

DEPRESS VECTOR BY A CONSTANT 

VARIABLE ORIGIN DISPLA FORMAT 

GENERATION 

DOUBLE VECTOR ELEMENTS, FLOATING 

DOUBLE VECTOR ELEMENTS, FIXED 

END-OF-FILE FLAG INDICATOR 

FOR REREAD . F 

END-OF-FILE SET FOR REREAD... 

EXCHANGE TWO VECTORS.... 

EXPAND LENGTH OF VECTOR 

BY AN INTEGRAL FACTOR.... 

FACTORIZE ENERGY DENSITY SPECTRUM..... 

SUM WITH FAP ACL INSTRUCTION 

FAST SCAN VECTOR FOR EXCESSIVE 

ELEMENT 

FAST TRANSIENT CORRELATION............ 

FAST TRANSIENT CORRELATION SUMMED 

FAST CUBIC EVALUATION ON UNIFORM 

GRID • 

FAST EQUI-PRODUCTS CORRELATION... 

FAST EQUI-PRODUCTS CORRELATION SUMMED. 
FAST TRACK THROUGH VECTOR OF INDICES.. 

FAST DOT PRODUCT 

FAST DOT PRODUCT WITH ONE VECTOR 

REVERSED... 

FILTER 8Y RECURSION IN 2 DIMENSIONS... 

FIX A FLOATING VECTGR 

FIX A FLOATING VECTOR WITH ROUNDING... 
FLOAT AND SCALE MACHINE LANGUAGE 

INTEGERS 

FLOAT A MACHINE LANGUAGE INTEGER...... 

FLOAT A FIXED VECTOR.... 

NORMAL OR LITERAL FORMAT OUTPUTED. . . . . 
FIND COMMON INDEX OF NORMAL OR 

LITERAL FORMAT 

ADVANCE FILM FRAME (FRAMEC709) AND 

FRAMEI709O) ).... 

FREQUENCY COUNT OF INTEGERS 

FREQUENCY COUNT IN RANGES ♦ 

FORWARD (OR BACK) SKIP TAPE FILES 

FOURIER TRANSFORM 24 POINTS 

(FT24 AND FT24-II).. 

FIX AND SCALE DATA TO MACHINE LANGUAGE 

INTEGERS. • 

GENERATE OUTPUT-TYPE HOLLERITH... 

GET HOLLERITH ARGUMENT 

GET RAND RANDOM DIGITS................ 

VARIABLE DEPTH INDEXING ....F 

GENERATE SYMMETRIC FILTER 



ING SEQUENCES ••••*»»«*»»•«•»*****»*•• 
♦ DOTP TO GNFLT1 » 
«**••*•«•*•»*•**»**«•«•• 



DOTP <NRA,NCA,AA,NRB,NC8,8B, 

IRB,ICB, DOT, ORDER! 

DPRESS (X,LX,XSINK,XLWRD) 

DSPFMT (CNTHOL, IORGX, IORGY, FMTEND,FMT I 

DUBLL CX,LX) 

DUBLX (IX,LIX) 

ENDFIL (ITAPEI 

EOFSET (ZIFTRN»EGF, I TAPE) 

EXCHVS (LXY,X,Y) 

EXPAND (X,LX,MLPLYR,XPNDED,LXPNDDI 

FACTOR ( SPECT,L SPEC T,L WAVE, WAVE , SPACE ) 

FAPSUM CLX,X,ACLSUM) 

FASCNi CVECT,ILO,IHI,VALUE, IFIND,IANS) 

FASCOR ( Y,KMIN»KMA X, COR ZER, ERROR ) 

FASCR1 (Y,KMIN,KMAX,CORZER, ERROR) 

FASCUB (COEFS,XLO,DELX,NF,FOFX) 

FASEPC <Y,KMIN,KMAX,C0RZER,ERRORI 

FASEPl ( Y, KM IN, KM AX, COR ZER, ERROR) 

FASTRK ( IXVEC , I XSTRT, I XLOOK , MXTRAK, 
IANS) 

FDOT (LXY,X,Y,DOTXY) 

FDOTR (LXY,X,Y,DOTXYR) 

FIRE2 (NRA ,NCAT,NCAN, AA,NRR,NCR,RR , 

NRG ,GG,FF,CC) 

FIXV {X,LX,IX) 

FIXVR (X,LX,IX) 

FLDATA (LX,X, SCALE) 
FLOATMF ( INTEGR) 

FLOATV CIX,LIX,X) 

FMTOUT (ITAPE,FMT) 

FNDFMT CFMT, IXCFMT ) 

FRAME 

FRQCT1 (IX,LIX,IXLO,IXHI,ICCUNT,IANS) 

FRQCT2 CX,LX,R,LR,ICOUNT,IANS) 

FSKIP ( ITAPE,NF ILES) 

FT24 (X,REAL,XIMAJ) 

FXDATA (LX,X,MXDATA, SCALE) 

GENHOL (HOLI... PRINT FMT, L I ST. . .FMT 
FORMAT { ) 

GETHOL <ZIFMUV,HARG,HIFMUV,NCRS,IXCCM, 
ICOUNT) 

GETRD1 ( I TAPE ,NRD, IRD , I ANS ) 

GETX (X, II, 12,..., IN) 

GNFLT1 ( AM SPEC, L SPEC, FLTR, IANS) 



****•******•»•»*»*••*»«* 

* GNH0L2 TO LINE • 
»**••*»*••*•«»#»*»»•••»» 



ANNOTATED CALLING SEQUENCES »♦«#**#**#*«**##«**«*#*» 

* GNHOL2 TO LINE * 
**•••••*•«»«**»•««•»»•«* 



GENERATE OUTPUT-TYPE HOLLERITH 
SCOPE GRAPH OF VECTOR SETS.... 



SUBROUTINE GRAPH EXPANDED 



FIND EQUALLY LIKELY GROUPINGS 

HALVE VECTOR ELEMENTS, FLOATING 

HALVE VECTOR ELEMENTS, FIXED 

HOLLERITH LEFT ADJUST.......... 

HOLLERITH RIGHT ADJUST...... 

HISTOGRAM PLOT ON SCOPE (HSTPLT, 
HSTPLT-II, HSTPLT- 1 1 H 709) , 
AND HSTPLT- I 1 1 C 7090 1* ........... . 

HOLLERITH VECTOR TO INTEGER VECTOR.... 

INVERSE TO VECTOR DERIVATIVE 

PSEUDO IF STATEMENT 

INVERSION OF MONOTONE FUNCTION 

VARIABLE DEPTH INDEXING ........F 

INVERSE TO VECTOR INTEGRAL 

INPUT DATA FROM FILE AS GENERATED BY 

OUDAT A. • • • • 



INDEX BY UNITY AND COMPARE 

INTEGRAL OF A VECTOR...... 

INTERPRET HOLLERITH 

INITIALIZE SUBROUTINE TIMSUB 

LINEAR INTERPOLATION OPERATOR 

FOR 1,2,3, OR 4 DATA VALUES 

INTEGRATED SUMMATION OF A VECTOR 

POLYNOMIAL EVALUATION FOR COMPLEX 

ARGUMENTS 

INTEGER VECTOR TO MACHINE LANGUAGE 

INTEGER VECTOR 

INTEGER VECTOR TO HOLLERITH VECTOR.... 

INDEX WITH RESPECT TO COMNON OF 

ARGUMENT • 

CHI-SQUARE TAIL INTEGRAL.. 

COLLAPSE VECTOR ABOUT MIDPOINT 

CHECK VARIABLES AGAINST THEIR LIMITS.. 

ARBITRARY LINE ON SCOPE 

(LINE(709) AND LINE(7G90)) 



GNH0L2 (DATA,NDATA,FMT,HOL,NCRSt IXCOM, 
INDEX) 

GRAPH (I SOL, IDOT,LVECS,TITLE,YUNITS, 
XUNITS,YTOP,YBOT,XMAX,XMIN, 
NOPPP,IPAGE, SPACE) 

GRAPHX (ISOL,IDOT,LVECS,TITLE,YUNITS, 
XUNITS,YTOP,YBOT,XMAX f XMIN, 
NOPPP, I PAGE, SPACE, NFRMSV) 

GRUP2 (PROB,LPROB,DELX,XLO,XLIMS, 
NGRUPS,IANS) 

HALVL (X,LX) 

HALVX (IX,LIX) 

HLADJ FfHOL) 

HRADJ F(HOL) 



HSTPLT (LNY,NY,ORG,NDELX,ZIFSOL tZIFAXS, 

IFRSTB,ISKIPB) 
HVTOIV <HV,LHV,IV) 
IDERIV ( Y0FX1 ,DYDX,DELX ,LY, YOFX ) 
IF SEVRAL ( . . . , 2HIF , X,NXNEG, NXZER, 

NXPOS,... ) 
IFNCTN <YOFX,LYOFX, XFIRST,XLAST,LXOFY, 

YLO , YHI , IERRLO, XOFY , I ANS ) 
IGETX (IX, U,I2,...,INI 
IINTGR (YOFX I ,YIGRTD,DELX,LY,YOFX, 

CIGRTN) 

INDATA ( I TAPE , IRECNO, NOPTS, DATA , ERR , 

6H AUXL1,AUXL1,6H AUXL2,AUXL2, 
... ,6H AUXLN, AUXLN) 

INDEX F(I,ICRTCL) 

INTGRA (CIGRTN, YOFX, LY, DELX ,YIGRTO, 
Y0FX1) 

INTHOL (NHOL,HOL,FMT,NDATAD,NDATAA, 
DATA) 

INTMSB 

INTOPR (NDATA,XLO,DELX,X,OPER) 
INTSUM (X,LX,XISUMD) 

IPLYEV (NCOFS,COFS,ZREAL,ZIMAJ,PREAL, 
PIMAJ) 

ITOMLI (IV,LIV,MLIV,IANS) 
IVTOHV (IV,LHV,HV) 

IXCARG (ARG, IXCOM) 
KIINT1 (CHISQ,NDF,PROB,IANS) 
KOLAPS (XMID,LXHAF,ZIFXD,LCHAF,CMID, 
ERR) 

LIMITS (IANSX1,IANS, XI,X1A,X1B, 

X2,X2A,X2B, XN,XNA,XNB) 

LINE (Xl,Yl,X2,Y2) 



«••»•»*•»»*»••»•»•»*•»•• 

• LINEH TO MOVECS * 
•••••»•»»»••*»•••••**«»» 



ANNOTATED CALLING SEQUENCES •#»»#»♦♦»#«#***#♦**»»»»» 

» LINEH TO MOVECS # 
**•«•**«••»»* ••«•«#*••»• 



HORIZONTAL LINE ON SCOPE 

(LINEH(709) AND LINEH(7G90)) 

VERTICAL LINE ON SCOPE 

(LINEVI709) AND L INEV ( 7090 )).... . 

LINEAR INTERPOLATION ..... 

LISTING OF AUXILIARY INFORMATION OF 

INDATA-OUDATA TAPE 

MACHINE LOCATION OF ARGUMENT 

LOCATE AND NAME A LIST OF SUBROUTINES. 

LOGICAL SHIFT FUNCTION................ 

LEAST SQUARES LINE 

LEAST SQUARES SHAPER BY 

SIDEWAYS ITERATION 

MATRIX INVERSE 

MATRIX MULTIPLY, SQUARE TIMES SQUARE.. 
MATRIX MULTIPLY......... 

TIGHT-PACKED MATRIX TRANSPOSE 

SQUARE MATRIX TRANSPOSE..... 

MAXIMUM ABSOLUTE VALUE OF VECTOR 

MAXIMUM ABSOLUTE VALUE MATRIX 

ELEMENT 

MAXIMUM SIGNED VALUE OF VECTOR........ 

MAXIMUM SIGNED VALUE MATRIX ELEMENT... 

DOT PRODUCT OF VECTORS OF SQUARE 

MATRICES..... 

DOT PRODUCT OF VECTORS OF MATRICES.... 

OUTPUT MEMORY USAGE DATA 

FACTOR IZE A NON-SINGULAR MATRIX 

MULTI-INPUT FILTER BY LEAST SQUARES... 

MINIMUM ABSOLUTE VALUE OF VECTOR 

MINIMUM ABSOLUTE VALUE MATRIX 

ELEMENT 

MINIMUM SIGNED VALUE OF VECTOR 

MINIMUM SIGNED VALUE MATRIX ELEMENT... 

MULTI-INPUT PREDICTOR-LEAST SQUARES... 
MULTI-INPUT SIDEWARDS ITERATION....... 

MACHINE LANGUAGE INTEGER VECTOR 

SCALING 

MACHINE LANGUAGE INTEGER CONVERTED TO 

FORMAT ( 2 A6 ) 

CHECK VECTOR FOR MONOTONE BEHAVIOUR... 
MATRIX OUTPUT IN G FORMAT........ 

MATRIX PRINTED OUT AS INTEGERS........ 

MOVE VECTOR ANYWHERE..... 

MOVE VECTORS ANYWHERE.... 



LINEH (IXLEFT,IYLEFT, IXRI TE, IDELX ) 

LINEV ( IXBOT,IYBOT, IYTOP, IOELYI 
LINTR1 ( X, XLO, DEL X,YT ABLE, L TABLE, YGFX ) 

LISTNG (ITPFIL,ITPOUT, SPACE) 

LOC (ARG, I ADARG) 

LOCATE (SU8RU1,SUBRU2,...,SUBRUN) 

CALL SUBR1... CALL SUBRN 
LSHFT F(NSHFT,X) 
LSLINE (Y,LY,XMIN,XMAX,C0,C1) 

LSSS1 (LPARF ,PEO, ACOR , RS I DE,FLTR, 
ERRCOV) 

MAT INV (LSQM,SQM,SQMINV, SPACE, ERR! 
MATML1 CLSQM, SQMA, SQM8 , SQMAXB,NZFADD ) 
MATML3 (N,M,L,AN8YM,BMBYL,N2FBTR,CNBYL, 
GZFADD) 

MATRA (MATRX, NROWS ,NCOLS ,MATRXTI 

MATRA1 (LSQM, SQM ) 

MAXAB (LX,X,XMAXAB, INDEX) 

MAXA8M (FOFIJ,LI,LJ,IDIMEN,FMAXAB, 

IMAXAB, JMAXAB ) 
MAXSN (LX,X,XMAXSN, INDEX) 
MAXSNM (FOFIJ,LI,LJ,IDIMEN,FMAXSN, 

IMAXSN, JMAXSN) 

MDOT (NRCAB,LAB,AA,BB,DOT,MIFREV) 

MOOT 3 <NRAD,NCARB,NC8D,LAB , AA, BB, 

ZIFNTR,DGT,MIFREVI 

MEMUSE (ITPOUT) 

MFACT (LSQM, SQM, SQMFAC) 

MIFLS (NRC ,LL,BB,RR,GG,FF,C) 

MINAB <LX, X, XM I NAB, INDEX) 

MINABM (FOFIJ,LI ,L J , IDIMEN, FMINAB, 

IMINAB, JMINAB) 
MINSN (LX,X,XMINSN, INDEX) 
MINSNM (FOF IJ,LI,LJ,IDIMEN,FMINSN, 

IMINSN, JMINSN) 
MIPLS (NRC ,LL,AA,BB,RR,C,ERR) 
MISS (NRC ,LL, AA, BB ,RR ,GG , FF ,C I 

MLISCL (MLIV,LMLIV,ISCALE,MLIVSC,IANS) 

MLI2A6 (MLI ,ML IHOL , NCRS ) 
MONOCK (X,LX,ZFNDCR,IANSNG, IANSI 
MOUT (ITAPE,NSPACE,X,XNAME,NRX,NCX, 
LX) 

MOUTAI { I TAPE ,N SPACE , FOF I J,FNAME,LI ,LJ, 

IDI MEN, NO I GS, SCALE, SPACE) 
MOVE (LX,X,Y) 

MOVECS (L1,X1,Y1,L2,X2,Y2,...,LN,XN,YN) 



»*»*•»•**•»»•*•»•*»••«»» ANNOTATED CALLING SEQUENCES »•»•••••»•••*••#»«*••«»» 
* MOVREV TO PLOTVS * * MOVREV TO PLOTVS • 

«*»*•»»******•*••*»*••• » ••*••*•*»»••*••*•««••••« 



MOVE, REVERSE, SPREAD, OR CHANGE 

SIGN OF VECTOR. ... 

MAP FLOATING SEQUENCE TO INTEGERS,.... 

REVERSE VECTOR OF MATRICES.... 

MEAN SQUARE CONTINGENCY AND 

DEPENDENCY. ••••••• 

MULTIPLY VARIABLES BY A CONSTANT 

(MULK AND MULK-II) 

MULTIPLY VARIABLES BY CONSTANTS 

POLYNOMIAL ROOTS BY MULLER f S METHOD... 

MULTIPLY VECTOR BY A CONSTANT 

MOVING ADDITION OF FIXED VECTOR.. 

MOVE A BLOCK • 

MOVING AVERAGE OF VECTOR 

MOVING SUMMATION WITH DIVISION........ 

MOVING TRAPEZOIDAL INTEGRAL 

MOVING ABSOLUTE TRAPEZOIDAL INTEGRAL. • 

MOVING SQUARE AVERAGE OF VECTOR 

MAXIMUM RATIO REGION OF TWO CUMULATIVE 
DISTRIBUTIONS 

NEXT COSINE VALUE 

NEXT SINE VALUE 

NORMALIZE MAGNITUDES 

NORMAL INTEGRAL UP TO X 

EQUI-L IKELY RANGES OF NORMAL INTEGRAL. 
NORMALIZE AND 800ST A VECTOR 

N-TH ARGUMENT BEYOND FIRST.... 

NEW RANGE AND INCREMENT OF VECTOR..... 

NEXT ALARM •• 

ONLINE DUPLICATION OF OFFLINE OUTPUT.. 
OUTPUT DATA AND AUXILIARY INFORMATION 
TO FILE TAPE 



READ EVERY N-TH WORD 

FROM BINARY TAPE 

PACK A FLOATING VECTOR, N WORDS PER 
REGISTER.... 

FAST TWO-DIMENSIONAL 

SPATIAL SPECTRUM........ 

PRINTER PLOT OF VECTORS, GENERAL... 



MOVREV aXY,IX,X,IYMIFR,Y, SIGN) 
MPSEQ1 (X,LX, XLMITS,NLMITS,IX,IXLC, 
IANSI 

MRVRS ( NR A ,NCA , L A , AA I 

MSCON1 (IJSIZE,POFIJ f CONTNG,DEPEN0, 
IANS) 

MULK (C,X1,X2,...,XN) 

MULKS (C1,X1,Y1,C2»X2,Y2,...,CN,XN,YN) 
MULLER (COEF,IDEGRE,ROOTR,RGOTII 
MULPLY (X,LX,XMLPLR,XMLPLDt 
MUVADD (IV, ILO, IHI , LAOD,MUVSUM, NSUMS , 
IANS) 

MVBLOK (NMOVE,IASORS,IADESTI 
MVINAV (X,LX,LAVHAF,XAV,IANS) 
MVNSUM (X,LX,LSUM,DVSR,SUMOVD,LSUMOD) 
MVNTIN CX,LX, DEL, LINT, XMI,LXMI) 
MVNTNA (X,LX,DEL,LINT,XAMI,LXAMII 
MVSQAV (X,LX,LAVHAF,XSQAV,IANS) 

MXRARE (DN,DD,LD,DNFRAC ,DDFRAC, MNREWI , 

RAMX, ILO, IHIt IANSI 
NEXCOSF(DUMMY) 
NEXSINF (DUMMY ) 
NMZMG1 (LX,X,XMAX, SCALE) 
NOINT1 (X,PROBX) 

NOINT2 (XMEAN,XSD,NDIV,XDIV,IANS) 
NRMVEC ( ZIFRMS, SCALE, X,LX,XME AN, 

XMAX, XNRM) 
NTHA F(N,A1,A2,.». ,AN,.«. I 
NURINC (YOFX,LY,XLO,XHI,LYNU,XLCNU, 

XHINU,IERRl,YOFXNU, IANS) 
NXALRM (JOB,MLIV,ILO,IHI,LEVEL,LTENSE, 

IBEGIN,IEND,ISUM,IANS) 
ONLINE (ISENSE) 

OUDATA ( ITAPE,IRECNC,NOPTS,DATA,MCDCOD, 
6H AUXL1,LAUXL1,AUXL1,..., 
6H AUXLN,LAUXLN,AUXLN) 

PACDAT (ITAPE,NWORDS,IFSTWD,IFOLD, 
DATA, LDATA, IANSI 

PAKN (NWPR, LDATA, DATA, SCALE) 

PLANSP ( JOB ,NRA,NCA , AA , MRS , JMAXR,MCS , 
JMAXC,SPT,SPACE1,SPACE2,IANS3) 

PLOTVS (ITAPE,ISENSE,LOCYV,YSMBV,LYV, 
IXSTRV,NY, ARGLO,ARGDEL, ZFAFXD, 
FMTARG,NCOLS, YBCT, YTOP,HLINV, 
HLSMBV,NHL) 



•«•*»••••»••»*»•*»••••*» ANNOTATED CALLING SEQUENCES 

» PLTVS1 TO REIM * 
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* PLTVSl 
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•*•*••• 

TO REI 
»»*•«»« 



•«»**• 

M • 
•»»«*» 



PRINTER PLOT OF VECTORS 

WITH AUTOMATIC SCALING PLTVSl 



PLURAL IZE A SUBROUTINE PLURAL 

PLURAL I ZE THE NEXT SUBROUTINE PLURNS 



POLYNOMIAL SYNTHESIZED FROM ITS 

COMPLEX ROOTS •• PLYSYN 

POKER COUNT OF DIGIT SEQUENCE POKCT1 

POLYNOMIAL DIVISION . . POLYDV 

REAL POLYNOMIAL EVALUATION POLYEV 

POLYNOMIAL SYNTHESIS FROM REAL AND 

COMPLEX ROOTS • POLYSN 

RAISE VECTOR TO POSITIVE OR 

NEGATIVE INTEGRAL POWER POWER 

PROBABILITY CURVE FITTED TO MOMENTS... PRBFIT 

SECOND ORDER PROBABILITY PROB2 

WRITE PROGRAM FOR CORRELATION PROCOR 

POLYNOMIAL SQUARE ROOT PSQRT 

PRINT OR WRITE OUT A MACHINE 

LANGUAGE INTEGER VECTOR PWMLIV 

QUICK AUTOCORRELATION.. QACORR 

QUICK CONVOLUTION QCNVLV 

QUICK FOURIER TRANSFORM QFURRY 

QUICK INVERSE FOURIER TRANSFORM QIFURY 

QUADRATIC INTERPOLATION IN TABLE QINTR1 

FIT QUADRATIC TO THREE DATA POINTS.... QUFIT1 

QUICK CROSS CORRELATION QXCORR 

QUICK CROSSCORRELATION OF ML I VECTORS 

WITH VARIABLE LIMITS..... QXCOR1 

READ DATA IN VARIABLE FORMAT RDATA 

REFIT EVEN AND ODD PARTS... REFIT 

REFLECT A VECTOR THROUGH A CONSTANT... REFLEC 
REAL AND IMAGINARY PARTS FROM 

AMPLITUDE AND PHASE REIM 



{ ITAPE , I SENSE, ARGLO, ARGDEL, 
ZFAFXD,NCOLS,ZFZERS,RMSSEP,S, 
LXf ZFLI ST f VMATRXf IDIMENt NX) 

OR 

( I TAPE , I SENSE, ARGLO , ARGDEL , 

ZFAFXD,NCOLS,ZFZERS,RMSSEP,S, 

LX,Q.O,Xl,X2,...,XN) 
(SUBROU,Al,A2,...,AN, 

Bl, B2,...,BN, ...... I 

(A1,A2,...,AN,B1,B2,...,BN, 

,Z1,Z2,...,ZN) 

OR 

( Alt A2, ANA, STOP, B1,B2,..., 
BNB , S TOP , , Z 1 , Z2 , . . . , Z NZ ) 

(SCALES, RAD 1 1 ,DGREES ,NROOTS, 

PLYCOS,NCOFS,SPACEI 
UX,NHANDS, I COUNT, IANS) 
(LDVSR ,DVSR , LDVDD, DVDD ,LQUCT , 

QUOT) 

(NCOFS,COFS,X,POFXI 

f SCALE, NOZ,ZRE,ZIM,ZIFCOM, 
ZIFCNJ,LPOLY, POLY, SPACE) 

CX,LX,N,X2NTH) 

<NMOMS,XMGMS,LX,X,POFX, SPACE, 
IANS) 

( IX, L IX, LAG, ICOUNT,PROB, IXHI , 
IANS) 

(X,LX,MAXX,PROGl,PROG2,ERR) 
(NCOFS,COFS,NCSQRR,CSQRR) 

(NWPL,ITAPE,MLIV,LMLIV,IANS) 
( X,LX,MXACC ,MXL AG, SPACE, ACOR , 
IANS) 

( X, LX,Y,LY,MXACC,LC, SPACE, C, 
IANS) 

(X,LX,IXZER,MFREC,JMIN,JMAX, 
SPACE ,FTREAL ,FT IMA J , IANS) 

(FTREAL,FTIMAJ,MFREQ,LX, IXZER, 
SPACE, X, IANS) 

( X, XLO ,DELX, TABLE, NT ABLE ,YOFX ) 

<FOFX,XLO,DELX,COEFS) 

(X,Y,LXY,MXACC,MXLAG, SPACE, XCOR, 
IANS) 

(LX, X,LY, Y,MXACC , ILAG »NL AGS , 
CQRR, ZIF STO,LSP ACE, SPACE, IANS) 

CITAPE,ITPCPY,IANS,SPACE, 
X1NAME,X1, X2NAME,X2, ... ) 

<X,LX,ZIFXD,SYM,ANT) 

(X,LX,XMIROR,XIMAGE) 

{ AMP,PHZ , LAMPHZ,REAL ,XIMA J ) 



**»***•»»»*»»«»*»»**»»** 

* REMAV TO SETUP » 
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ANNOTATED CALLING SEQUENCES «*»»»**•*«»»»*»###««»»#« 

» REMAV TO SETUP « 
«»•»••»»*•••»*#**•*«•«*• 



REMOVE AVERAGE OF A VECTOR ........... 

REREAD BCD RECORDS 

RETURN TO CALLING PROGRAM 

REVERSE A VECTOR 

REVERSE A VECTOR 

REALIZABLE LEAST SQUARES PREDICTION 

ERROR OPERATOR BY RECURSION...... 

REALIZABLE LEAST-SQUARES PREDICTOR BY 

RECURSION - 2-DIMENSIONAL 

REALIZABLE LEAST SQUARES SHAPER 

BY RECURSION 

RMS DEVIATION FROM AVERAGE... 

RMS DEVIATION FROM BASE VALUE 

ROUND FLOATING NUMBER. 

ROUND A FLOATING NUMBER DOWN.......... 

ROUND A FLOATING NUMBER UP 

ROUND A FLOATING VECTOR 

ROUND DOWN A FLOATING VECTOR 

ROUND UP A FLOATING VECTOR 

ROTATE CENTRO-SYMMETRIC OR ANTI- 
SYMMETRIC 2-DIMENSIONAL ARRAY.... 

ROTATE A VECTOR 

REPLACE FORMAT IN NEXT INPUT OR 

OUTPUT STATEMENT 

RECORD SKIPPING ON TAPE 

REVERSE EVEN AND ODD PARTS 

SAME OUTPUT AS INPUT 

SCOPE SCALING OF DATA... 

SEARCH VECTOR FOR VALUE 

INITIALIZE FOR SEQUENTIAL 

SINE AND COSINE VALUES 

SET FIRST ARGUMENT AND PLACE 

THIRD IN ACCUMULATOR 

SET ARGUMENT AND TEST ITS SIZE 

SET UP AN INDATA-OUCATA TAPE FOR 

RECEIVING ADDITIONAL RECORDS 

SET VARIABLES TO A CONSTANT 

(SETK AND SETK-IH 

SUBROUTINE SETK PLURAL I ZED 



SET VARIABLES TO CONSTANTS 
(SETKS AND SETKS-II). 

SET A CONSTANT VECTOR 

SET CONSTANT VECTORS 

SET LINEAR VECTOR. 

SET LINEAR VECTORS 



SET SUBROUTINE VECTOR.... 
SET UP SUBROUTINE LINKAGE 



REMAV (X,LX,XAVG,XNULDI 

REREAD 

RETURN (LOCALL, XRl , XR2) 
REVER (X,LX,XREVD> 
REVERS (LX,XI 

RLSPR (LPA,PEO,ACOR,ERRCOV) 

RLSPR2 (NRA tNCAT t NCANt AA 9 NRRt NCRff RR , 
CC, IANS) 

RLSSR (LPARF,PEO,ACOR,RSIDE,FLTR, 

ERRCOVI 
RMSDAV (X,LX,XAVG,RMSXMA) 
RMSDEV CXtLXt XBASE tRMSXMB) 
RND FIX) 
RNDDN FCXI 
RNDUP FIX) 
RNDV (X,LX,XR) 
RNDVDN (X,LX,XR) 
RNDVUP (X,LX,XR> 

ROAR2 (IISMIA,XA,N,M,XRA) 
ROTATl CX,LX,NUP,ROTX) 

RPLFMT (FMT tFMTNEW) 
RSKIP INTAPE tNRECS t EOF ) 
RVPRTS (SYMt ANTt N) 
SAME FUXI 

SCPSCL (DATA f LDATA t YTOP t YBOT ,CQNVK 9 
CONVL) 

SEARCH (LX9X9XWANT9 INDEX) 

SEQSAC ( ARGLO t ARGOEL ) 

SETAPTF ( X v XNEWtF VALUE ) 
SETESTFCX, XNEW, XCRTCLI 

SETINO (ITAPEtZIFNEWfNRECSflERR) 

SETK (C,Xl t X2»...,XNI 

SETKP {Cl,XLl,Xl2»...,XlNl f STOP, 
C2, X2 It X22 f . . . , X2N2 f STOP, 
,CM, XM1, XM2,... ,XMNMI 

SETKS (Cl f Xl,C2tX2»... ,CN,XN) 
SETKV (CtLXtXI 

SETKVS (Cl,Ll,Xl,C2,L2,X2,...,CN f LN f XNI 

SETLIN (BASE, DELTA, LX,XI 

SETLNS (BASE1,DELTA1,LX1,X1,BASE2, 

DELTA2,LX2,X2,...,BASEN, 

DELTAN,LXN,XN) 
SETSBV ( SUBRU ♦ SUBRUV, ARG1 , ARG2, . . . , 

ARGN) 

SETUP (LOCALL,NARGS,XRl,XR2) 



•*«*•»»»*»»*«•»*»»•»«*»» ANNOTATED CALLING SEQUENCES 

* SETVCP TO TAMVL • 
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» SETVCP TO TAMVL • 
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SUBROUTINE SETVEC PLURALIZEO 



SET VECTOR FROM LIST . . 

OPERATE SEVERAL SUBROUTINES .. 

SHIFT VECTOR ELEMENTS RIGHT 

ARITHMETICALLY... 

SHIFT VECTOR ELEMENTS RIGHT LOGICALLY. 

SHUFFLE THE INTEGERS 1 TO N.. 

SIFT OUT EQUALLY SPACED VALUES 

SOLVE SIMULTANEOUS EQUATIONS 

A(I, J)*X( J,K) = B(I f KI... 

SINE TABLE GENERATION, FLOATING....... 

SINE TABLE GENERATION, FIXED.......... 

SINE SPECTRUM 

MAKE SIZE INDEX OF ALGEBRAIC VECTOR... 

MAKE SIZE INDEX OF LOGICAL VECTOR 

SUM INTEGRAL POWER OF DEVIATIONS OF 

VECTOR ELEMENTS FROM BASE. 

MULTI-PURPOSE SIMPSON'S RULE 

INTEGRAL.. 

FAST 2-DIMENS IONAL SPATIAL 

CROSSCORRELAT ION. 



SPLIT INTO EVEN AND ODD PARTS 

SUM OF SQUARE DEVIATIONS OF VECTOR 

FROM BASE..... 

SUM OF SQUARED VECTOR DIFFERENCES..... 
SQUARE MACHINE LANGUAGE INTEGER 

VECTOR.... 

SQUARE ROOT OF A VECTOR......... 

SQUARE SUM OF VECTOR ELEMENTS. 

SQUARE VECTOR ELEMENTS..... 

SEARCH VECTOR FOR VALUE BEGINNING 

AT EITHER END 

UNIT STEP FUNCTION, CENTERED 

BETWEEN PLUS AND MINUS ZERO...... 

UNIT STEP FUNCTION, TO LEFT OF ZERO... 
UNIT STEP FUNCTION, TO RIGHT OF ZERO.. 

STORAGE-TO-TAPE HOLLERITH..... 

STORAGE-TO-TAPE HOLLERITH DEBUG 

STORAGE-TO-TAPE HOLLERITH MONITOR 

STORE SUBROUTINE ARGUMENT.. 

STORE ZEROES IN A VECTOR 

STORE ZEROES IN A LIST OF VECTORS..... 

SUBTRACT CONSTANT FROM VARIABLES 

SUBTRACT CONSTANTS FROM VARIABLES..... 

SUM VECTOR ELEMENTS............ 

SUM OF DEVIATIONS FROM BASE.. 

SUM OF VECTOR DIFFERENCES 

TEST SPECIFIED SENSE SWITCH...... 

TRIANGULAR AVERAGE MOVING LEFT END.... 



SETVCP <X1,C11,C12, tClNlfSTOPt 
X2,C21,C22,...,C2N2,STOP, 
....... XM,CMl ,CM2 , . . . ,CMNM ) 

SETVEC (X,C1*C2,... ,CNI 

SEVRAL (SUBRUA,Al,A2,...,ANA, 

SUBRUB,B1,B2,...,BNB....... ) 

SHFTR1 (NSHFTR,IX,LIX, IXSH,IANSI 

SHFTR2 (NSHFTR,IX,LlX,IXSHiIANSI 

SHUFFL (ITPRD,NITEMS,ISPACE,IXSHUF) 

SIFT (X,MESH,LXSFTD, XSFTD ) 

SIMEQ UDIMEN,I JSI ZE ,KSI ZE , ATHENX, B , 

STHEND, SPACE, ERR) 
SINTBL (MFREQ , S INTAB ) 
SINTBX (MFREQ, ISINTBI 
SISP { SAX, AAX,MXL AG, S INTAB, MFREQ, 

JMIN, JMAX,ZIFXD,SINTR) 
SIZEUP (X,LX, INDEX) 
SIZUPL ( X,LX, INDEX I 

SMPRDV IX, LX,N, XBASE, SXMB2N) 

SMPSON (JOB, X,LX,DELX, XINT, IANSI 

SPC0R2 (NRX,NCX,XX,NRY,NCY,YY,MXACC, 
ILGR,NRZ,ILGC, INC,NCZ,ZZ, 
SPACE, IANSI 

SPLIT (X,LX,ZIFXD,SYM,ANT) 

SQRDEV (X, XBASE, LX,SSQXMBJ 
SQRDFR (X,Y,LXY,SSQXMYI 

SQRMLI (MLIVEC,ILO,IHI,MLISCR,IANS) 
SQROOT (X,LX,XSQRTD) 
SQRSUM (X,LX,SUMSQXI 
SQUARE (X,LX,XSQRD) 

SRCH1 ( I 1F2B,LV,V, VALUE, INDEX) 

STEPC F(ARG) 
STEPL F(ARG) 
STEPR F(ARG) 

(STH) -NOT AVAILABLE BY FORTRAN CALLS- 
(STHDI -NOT AVAILABLE BY FORTRAN CALLS- 
(STHM) -NOT AVAILABLE BY FORTRAN CALLS- 
STORE ( ARGU, LOCAL L ,NUMARG, IXVECT) 
STZ (LX,X) 

STZS (LX1,X1,LX2,X2,... ,LXN,XNI 
SUBK (C,X1,X2,...,XN) 

SU8KS (C1,X1,Y1,C2,X2, Y2,... ,CN,XN,YN) 

SUM (X,LX,SUMXI 

SUMDEV ( X, XBASE ,LX, SUMXMB I 

SUMDFR (X,Y,LXY,SUMXMY) 

SWITCHF(ISENSE) 

TAMVL (X,LX,LAVG,AVGL) 



»*»*****»•*»*»»•**•*»*»« 
♦ TAMVR TO XDIVK * 
****•••**••*»*»****•**•• 



ANNOTATED CALLING SEQUENCES #*♦»«#»♦»**»»»*•*»#«*•»• 

* TAMVR TO XDIVK ♦ 
****••»•••••«»•»*•«••»»« 



TRIANGULAR AVERAGE MOVING RIGHT END... TAMVR (X, LX,LAVG f AVGR) 

REAL TIME BETWEEN 2 MACHINE LOCATIONS. TIMA2B (LOCA,LOCB f MINACCSECS) 

REAL TIME OF NEXT SUBROUTINE.. TIMSUB (MINACC, SECS ) 

DEFINITE TRAPEZOIDAL INTEGRAL TINGL (YOFX,LX,DELX,TING> 

DEFINITE TRAPEZOIDAL INTEGRAL 

OF ABSOLUTE VALUE TINGLA I YOFX,LX,DELX,TINGA> 

TERMINATE AN I NDATA-OUDATA TAPE TRMINO { I TAPE ,NBAKUPI 

TAPE-TO-STORAGE HOLLERITH (TSH) -NOT AVAILABLE BY FORTRAN CALLS- 
TAPE-TO-STORAGE HOLLERITH MONITOR ( TSHM) -NOT AVAILABLE BY FORTRAN CALLS- 
UNPACK, N WORDS PER REGISTER UNPAKN (NWPR,LUDATA , DATA , SCALE ) 

SET FOR VARIABLE ARGUMENT COUNT VARARG (LOCSl 

VECTOR DOTTED WITH VECTOR..... VDOTV (X, Y ,LXY,DVSR, XDYODV ) 

VECTOR DIVIDED BY VECTOR VDVBYV (X, Y,LXY, XDVBYY) 

VECTOR OUTPUTED BY NORMAL OR 

LITERAL FORMAT VECOUT ( ITAPE ,FMT, X, ILO» IHII 

INDEX BY VARIABLE AND COMPARE......... VINDEXF ( I , ICRTCL , I JUMP ) 

VECTOR MINUS VECTOR VMNUSV (X, Y, LXY, XMNUSY) 

VECTOR OUTPUTED WITH LABEL BY 

NORMAL OR LITERAL FORMAT......... VOUT < I TAPE ,NSPACE , X, XNAME ,XFMT , I LO, 

IHI I 

VECTOR PLUS VECTOR..... VPLUSV ( X, Y , LXY, XPLUSY) 

VARIABLES OUTPUTED BY NORMAL 

OR LITERAL FORMAT VRSOUT ( I TAPE ,NSPACE , FMT, SPACE, XI , X2 , 

... ,XN) 

VECTORS OUTPUTED WITH LABELS BY 

NORMAL OR LITERAL FORMATS VSOUT ( I TAPE ,NSPACE , XI ,X1NAME, X1FMT , 

IL01,IHIl,X2,X2NAME,X2FMT, IL02, 
IH 1 2 , . . . , XN , XNNAME , XNFMT , I LCN , 
IHIN) 

VECTOR TIMES VECTOR VTIMSV ( X, Y ,LXY, XT I MSY ) 

WIENER AUTOCORRELATION WAC (LX, X, LACOR, ACORI 

FIND WHERE SUBROUTINE IS WHERE ( SUBRU , I ANS , LOC , NARGS ) 

CHOOSE WHICH OF TWO ARGUMENTS TO USE.. WHICH F t XI , X2 , ZI FX 1 ) 
Wi ENER-LEV INSON LEAST-SQUARES FILTER 

OR PREDICTOR WLLSFP (MXLAG,ACOR,RSIDE,LF ILTR,FILTR, 

AUXSEQI 

WRITE BINARY RECORD ON TAPE WRTDAT ( I TAPE ,DATA , LDATA , I ANS ) 

EXACT EQUALITY TEST INCLUDING 

SIGN BIT...... XACTEQF(X,YI 

FIXED ADD CONSTANT TO VARIABLES XADDK UC, 1X1, 1X2, ♦. . , IXNI 

FIXED ADD CONSTANTS TO VARIABLES...... XADDKS C IC1 , I XI , I Yl , IC2 , I X2 , I Y2 , . . . , 

ICN,IXN,IYN) 

GET FIXED SUBROUTINE ARGUMENT XARG F (LOC ALL, NUMARG, I XVECT I 

FIXED AVERAGE OF A VECTOR... XAVRGE ( IX,LIX, IXAVGI 

FIXED AVERAGE WITH ROUNDING OF A 

VECTOR............ XAVRGR ( I X , L I X, I XAVG ) 

FIXED BOOST VECTOR BY A CONSTANT XBOOST ( IX, LI X, I XRI ZE , I XBSTDI 

ALGEBRAICALLY COMPARE 2 VARIABLES XCMPRAF ( XI , X2 ) 

MODIFY CROSS CORRELATION FOR DANIELL 

SPECTRUM, FLOATING XDANL (XCORZ,MXLAG,MDAN,DXCORZ) 

MODIFY CROSS CORRELATION FOR DANIELL 

SPECTRUM, FIXED.......... XDANX ( IXCORZ,MXLAG,MDAN,D IXCRZI 

FIXED UNIT DELTA FUNCTION XDELTAF ( ARG ) 

FIXED DIFFERENCE A VECTOR BY 

ELEMENT PAIRS........... XDFPRS ( I X, LI X, I XPRSDi 

FIXED DIVISION XDIV F (NUMERA, IDENOMI 

FIXED DIVIDE VARIABLES BY A CONSTANT.. XDIVK UC , 1X1 , I X2 , . . . , IXN) 



*»•*»»•»*••»*»»•••••»»•• 

* XOIVKS TO XSTEPR * 
*••*•»»••*•»»•»»*•»•»»•» 



ANNOTATED CALLING SEQUENCES 



*«*«•*•••»****«*»#••••*«* 

» XDIVKS TO XSTEPR * 
«••••*»«•*«*»•***•••«••• 



FIXED DIVIDE VARIABLES BY CONSTANTS... 

FIXED DIVISION WITH ROUNDING*. 

FIXED DEPRESS VECTOR BY A CONSTANT.... 

FIXED DIVIDE VECTOR BY A CONSTANT 

FIXED DIVIDE VECTOR BY CONSTANT WITH 

ROUNDING 

FIXED DIVIDE AND ROUND VARIABLES 

BY A CONSTANT..... 

FIXED DIVIDE AND ROUND VARIABLES 

BY CONSTANTS 

FIX FLOATING TO MACHINE LANGUAGE 

INTEGER •••• 

INOEX WITH RESPECT TO COMMON OF 

SUBROUTINE ARGUMENT 

LENGTH OF COMMON AVAILABLE OR USED.... 

FIXED LIMIT CHECKING FUNCTION 

FIXEO VECTOR FROM APPLYING XLOC 

FUNCTION TO LIST OF ARGUMENTS.... 

LOGICAL SHIFT FUNCTION 

FIXED MULTIPLY VECTOR BY A CONSTANT... 
FIXEO MULTIPLY VARIABLES BY A 

CONSTANT. • 

FIXED MULTIPLY VARIABLES BY 

CONSTANTS 

COMPARE HOLLERITH NAMES 

FIND NUMBER OF SUBROUTINE ARGUMENTS... 
FIXED N-TH ARGUMENT BEYOND FIRST...... 

FIXED INTEGRATED SUMMATION 

OF A VECTOR 

FIXED ONE IF ODD, ZERO IF EVEN 

FIXED REMOVE AVERAGE OF A VECTOR 

FIXED REFLECT A VECTOR THROUGH 

A CONSTANT 

SAME OUTPUT AS INPUT 

FIXED SUM OF DEVIATIONS FROM BASE..... 

FIXED SUM OF VECTOR DIFFERENCES....... 

CROSS POWER SPECTRUM FROM CROSS 

CORRELATION 



FIXED SUM OF SQUARE DEVIATION OF 

VECTOR FROM BASE... 

FIXED SUM OF SQUARED VECTOR 

DIFFERENCES 

FIXED SQUARE ROOT OF A VECTOR 

FIXED SQUARE SUM VECTOR ELEMENTS. • 

FIXED SQUARE A VECTOR 

FIXED UNIT STEP FUNCTION, CENTERED 

BETWEEN PLUS AND MINUS ZERO. • 
FIXED UNIT STEP FUNCTION, 

TO LEFT OF ZERO 

FIXED UNI T STEP FUNCTION, 

TO RIGHT OF ZERO... 



XDIVKS IIC1,IX1, IY1,IC2,IX2,IY2,... , 

ICN,IXN,IYN) 
XDIVR F (NUMERAf IDENOM) 
XOPRSS (IX,LIX, IXSINK, IXLWRD) 
XDVIDE CIX,LIX,IXDVSR,IXDVODI 

XDVIDR (IX.LIX, IXDVSR,IXDVDD) 

XDVRK (IC, IXi,IX2,..., IXN1 

XDVRKS (IC1,IX1, IY1,IC2, 1X2,1 Y2 , . . . , 
ICIM, I XN, IYN) 

XFIXM F(ZFTRNCFLTG) 

XINDEXF (LOCALL,NUMARG) 

XLCOMNFIZIFACTJ 

XLIMITF(X,XA,XB) 

XLOCV (LOC V, XI , X2 , . . . , XN ) 

XLSHFTF (NSHFT, I X > 

XMLPLY (IX,LIX,IXMPLR,IXMPLC) 

XMULK ( IC , I X 1 , I X2 , . . . , I XN ) 

XMULKS (ICltlXlt IY1,IC2,IX2,IY2, ... , 

ICN,IXN, IYN> 
XNAME F (HNAME1, HNAME2 ) 
XNARGSF (LOCALLY 

XNTHA F(N,IA1,IA2,...,IAN,...) 

XNTSUM (IX,LIX,IXISMD) 

XOOZE FCINTGER) 

XREMAV (IX, LIX,IXAVG,IXNULD) 

XRFLEC (IX, LIX,IXMIRR, IXIMGE) 
XSAME F(Xi 

XSMDEV (IX,IXBASE 9 LIX,ISMXMB) 
XSMDFR (IX, IY,LXY, ISMXMY) 

XSPECT (XCORZ,MXLAG,COSTAB,SINTAB, 

MFREQ, JMIN, JMAX, CSPECSSPEC, 
SPACE, ERR) 

XSQDEV (IX, IXBASE,LIX, ISSXMB1 

XSQDFR (IX, IY,LXY, ISSXMY) 
XSQRUT (IX, LIX,IXSQRT) 
XSQSUM (IX,LIX,ISMSQX) 
XSQUAR UX,LIX, IXSQRD) 

XSTEPCF ( ARG ) 

XSTEPLF ( ARG ) 

XSTEPRF ( ARG ) 



**»»«**•*»*•»••*»«»«**•• 
• XSTLIN TO ZEFBIN » 
•*»**•••****•***••**•**» 



ANNOTATED CALLING SEQUENCES #»♦**»»#»»»»»«**»»#•**#* 

* XSTLIN TO ZEFBIN * 
*•••****••*«•**••»•***•* 



FIXED SET LINEAR VECTOR , 

FIXED SUBTRACT CONSTANT FROM 

VARIABLES. ....... 

FIXED SUBTRACT CONSTANTS FROM 

VARIABLES 

FIXED SUM VECTOR ELEMENTS 

FIXED VECTOR DIVIDED, WITH ROUNDING, 

BY VECTOR 

FIXED VECTOR DIVIDED BY VECTOR 

FIXED VECTOR MINUS VECTOR 

FIXED VECTOR PLUS VECTOR 

FIXED VECTOR TIMES VECTOR 

FIXED CHOOSE WHICH OF 

TWO ARGUMENTS TO USE. • 

ZERO IF END-OF-FILE, BCD TAPE 

ZERO IF END-OF-FILE, 8INARY TAPE.... 



XSTLIN <IBASE,IDELTA,LIX,m 

XSUBK (IC, I XI, 1X2,..., IXN* 

XSUBKS UCI,IX1,IY1,IC2,IX2,IY2,... , 

ICN,IXN, I YN ) 
XSUM UX,LIX,ISUMX) 

XVDRBV UX,IY,LXY,IXDRBY) 
XVDVBV UX,IY,LXY, IXDVBY) 
XVMNSV (IX,IY,LXY,IXMNSY) 
XVPLSV (IX,IY,LXY,IXPLSYI 
XVTMSV (IX,IY,LXY,IXTMSY) 

XWHICHFCIX1,IX2,ZIFIX1) 
ZEFBCDF ( I TAPE ) 
ZEFBINF ( ITAPE ) 



Program Digests 



Experience has shown that the annotated calling sequences of the previous section sup- 
ply perhaps 50 to 75 per cent of the information needs of the working programmer 
once he has become generally familiar with the program set. Practically all of his 
remaining needs are provided by the digest of the present section. 

The 4 'program digests" listed here are highly compact statements of input-output 
functional specifications, augmented by data on language, storage requirements, entry 
names, and transfer vectors. They do not include timing information. The ordering 
is again alphabetic by entry name; identically named entries have separate digests when 
there are functional differences. 

The digests pivot around the calling sequences, and the reader will note that their 
representations here differ somewhat from those of the previous section. The argu- 
ment names used in this section are identical to those chosen by the authors as shown 
in the program listings of Section 10. 

It is possible to use these digests as introductory abstracts of the program func- 
tions, but the compact notations and numerical details involved make reading difficult. 
The abstracts given in the program listings are much more suitable for this purpose, 
even if less convenient for scanning. 
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****»*»**»»»•»»**»»«*•*» 

• ABSVAL TO ARCTAN * 
»***•»*«•»»****•»*»••••* 



PROGRAM DIGESTS 



»**•»»•*»••«*•*«•••••••• 

* ABSVAL TO ARCTAN • 
••******»•*•••»**»»«•«•• 



AN «F« PRECEDING THE LEFT PARENTHESIS OF THE CALLING SEQUENCE 
SIGNIFIES A 'CLOSED FUNCTION 1 ROUTINE. 



ABSVAL (ANYVEC, ILO, IHI,ABSV£C,IANS) FAP, 50 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS ABSVEC(l...IHI-ILO+l) = MAGNITUDE OF ANYVEC ( ILO. .. IHI ) . 
EQUI V( ABSVEC , ANYVEC ( ILO ) ) OK. SETS IANS=0 IF OK, =-1 IF ILO LSTHN 1 OR 
IF IHI LSTHN ILO. 



ADANL ( AA,N,M,DAA) FAP, 183 REGISTERS 

OTHER ENTRIES - XDANL , ADANX,XDANX. TRANSFER VECTOR - SIN. 
SETS DAAU...N + 1) * DA(O...N) WHERE DA(L) * ( M/ ( L*P I )) »A CL > *SIN( L»PI /Ml 
AND A(C...N> IS FURNISHED IN AA( 1. • .N+l ) , WHERE N MUST BE GRTHN= 0, 
M GRTHN 0. EQUIVt DAA, AA) OK. 

ADANX ( I AA,N,M, IDAA! FAP, SECONDARY ENTRY OF ADANL 

SAME FUNCTION AS ADANL EXCEPT INPUTS, I AA( 1. ..N+l ) , AND OUTPUTS, 
IDAA(1...N+1), ARE FIXED POINT. 



ADDK (C,X1,X2,...,XN) FAP, 114 REGISTERS 

OTHER ENTRIES - SUBK ,MULK, DI VK, XADDK, XSUBK, XMULK, XD I VK, XDVRK, AODKS , 
SUBKS,MULKS,DIVKS,XADDKS,XSUBKS,XMULKS,XDIVKS,XDVRKS. NO TRANSFER 
VECTOR. 

SETS X1=X1*C, X2=X2+C, XN=XN+C. EQUI V (ANY ARGUMENTS) CK, BUT 

INITIAL VALUE OF C IS ALWAYS THE ADDEND. STRAIGHT RETURN IF N*0. 



ADDKS (C1,X1,Y1,C2,X2,Y2,...,CN,XN,YN) FAP, SECONDARY ENTRY OF ADDK 

SETS Yl«Xl+Clt Y2=X2+C2, YN-XN+CN. EQUI V( ANY TWO ARGUMENTS I 

OK BUT MAY CHANGE INPUTS CJ OR XJ. PROCESSING IS LEFT TO RIGHT. 
STRAIGHT RETURN IF N=0. 



AMPHZ (RE,XIM,LR,AMP,PHZ,R) FAP, 149 REGISTERS 

OTHER ENTRY - REIM. TRANSFER VECTOR - ATAN, SQRT,RND,COS,SIN. 
SETS AMP ( 1 • • .LR ) ■ AMPLITUDE, PHZU...LR) = PHASE IN RADIANS OF REAL, 
IMAGINARY PARTS REU...LR), XIMU...LR). R*0. GIVES PHZ FROM +PI TO 
-PI, NOT=0. GIVES PHZ CONTINUOUS. EQUI V (RE , AMP ) , I XI M, PHZ) OK. 

ARBCOL (FOFIJ, LI, LJ, IDIMEN, FJCOL, COL) FAP, 129 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - INTOPR. 
SETS C0L(1...LI) BY CUBIC INTERPOLATION BETWEEN THE FOUR COLUMNS 
F0FIJ(1...LI,K) K*J-1« JtJ + lvJ + 2 OF THE MATRIX FOF I J ( 1 . . . L 1 , 1. . . L J ) , 
WHERE J « FJCOL ROUNDED DOWN TO NEAREST INTEGER, EXCEPT THAT QUADRATIC 
OR LINEAR INTERPOLATION IS EMPLOYED IF NECESSARY TO AVOID USE OF K 
VALUES LSTHN 1 OR GRTHN LJ. LI AND LJ MUST EXCEED ZERO, FJCOL 
MUST BE GRTHN= 1.0 AND LSTHN* FLOATF( L J+l ) , AND CALLER MUST USE 
DIMENSION FOFIJ( IDIMEN, IGNORED) WITH IDIMEN GRTHN* LI. STRAIGHT 
RETURN WITH NO OUTPUT FOR ILLEGAL LI, LJ, IDIMEN, OR FJCOL. 

ARCTANF( X, Y) FAP, 29 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - ATAN. 
HAS VALUE ANGLE (IN RADIANS) (-3.14159265 LSTHN ANGLE LSTHN* 
3.14159265) CORRESPONDING TO THE POINT (X,Y) . 



»•*•*»»»*•**•****»»•*»»» 

* ARG TO CALL2 * 

•»»»»»•»•*•**••»*»•*»**• 



PROGRAM DIGESTS 



*••••*•••••*«»••*••««**• 

» ARG TO CALL2 * 

»»»»•*•««•»*••»•••#«»••» 



ARG F ( LOCAL LfNUM ARG, IXVECT ) FAP, SECONDARY ENTRY OF LOCATE 

GIVES ELEMENT NO. IXVECT OF THE VECTOR WHICH IS ARGUMENT NO. NUMARG 
OF THE CALL STATEMENT AT MACHINE ADDRESS LOCALL. 

ASPECT (ACOR,N,COSTAB,M, JMIN, JMAX, TYPE, SPECT, SPACE, FAP, 278 REGISTERS 

ISCALE , ERR) 

NO OTHER ENTRIES. TRANSFER VECTOR - COLAPS,COSP,DUBLX, DUBLL , 
SPLIT, RVPRTS. 

SETS SPECT i 1 . • • JMAX- JMIN+1 ) « SP{ JMIN. . . JMAX ) WHERE SP(J) = AC(O) ♦ 
2*SUM(FROM 1 = 1 TO N) OF C AC ( I) *COS ( I • J*P I /M I 1 WHERE ACIO...N) FURNISHED 
IN ACORU...N+1). M,N EXCEED ZERO, AND 0 LSTHN* JMIN LSTHN JMAX 
LSTHN* M. TYPE -0. FOR ACOR FXD, NOT*0. FOR ACOR FLTG. SPACE ( 1. . .2»M*1 ) 
IS SCRATCH IN CASE M LSTHN* N. ISCALE IS OUTPUT SCALE FACTOR FXD PT 
CASE ONLY. EQUIV( ACOR, SPACE) OK BUT DESTROYS ACOR. SETS ERR=0. IF CK, 
■1. IF N, M, JMIN OR JMAX ILLEGAL. 

ASPEC2 ( ACOR, MXLAG, FREQLO, FRQDEL, FAP, 74 REGISTERS 

NFREQS , I ERRLO, SPECT, I ANS ) 

NO OTHER ENTRY. TRANSFER VECTOR - SEQSAC ,NEXCOS. 
SETS SPECUJ) » AC(O) + 2*SUM { FROM 1=1 TO MXLAG) OF 

(AC(I)*COS(I»W(J))) FOR J * 1...NFREQS, WHERE W(J)=FRECLO*(J-U*FRCDEL 
RADIANS, AND WHERE AC ( 0. . .MXLAG) FURNISHED IN ACOR ( 1. ..MXLAG+1 t • 
REQUIRE MXLAG GRTHN* 0, NFREQS GRTHN* 1 . SETS IANS=C IF OK, 
*IERRLO IF MXLAG ILLEGAL, =IERRL0+1 IF NFREQS ILLEGAL. 

AVRAGE (X,LX,XAVG) FAP, 24 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XAVG = (1/LX) * SUM (FROM 1= 1 TO LX) OF XII). STRAIGHT RETURN IF 
LX LSTHN 1. 



BLKSUM (X,LX,LBLOK,DVSR,XBSMOD,LXBSOD) FAP, 49 REGISTERS 
NO OTHER ENTRIES. NO TRANSFER VECTOR. 

SETS LXBSOD = LX/LBLOK ROUNDED DOWN AND SETS XBSMOD(I) * 
U/DVSR) * (SUM (FROM J* ( 1-1 )*LBL0K*1 TO I»LBLOK) OF XIJI ) 

FOR I=1,2,...,LXBS0D. EQUIVALENCE (X,XBSMOD) OK. STRAIGHT RETURN 

WITH NO OUTPUT IF LX OR L8L0K LSTHN 1, IF LBLOK GRTHN LX, CR 
IF DVSR « 0.0 . 



BOOST {X,LX,XRIZE,XBUSTD) FAP, 34 REGISTERS 

OTHER ENTRIES - XBOOST, OPRESS, XDPRSS. NO TRANSFER VECTOR. 
SETS XBUSTDU...LX) - X( 1. . .LX ) +XRIZE. EQUIV ( X, XBUSTD) OK, AND 
EQUIVURIZE, SOME Xil)) OK, BUT INITIAL VALUE OF XRIZE IS ALWAYS THE 
ADDEND. STRAIGHT RETURN IF LX LSTHN 1. 

CALL (SUBRU, I ANS, SPACER, ARG 1,ARG2,. .., ARGN) FAP, SECONDARY ENTRY OF LOCATE 
IS SAME AS CALL SUBR ( ARG1 . . . ARGN ) WHERE SUBRU IS PROXY NAME FOR 
SUBR AND SPACER IS DUMMY. SETS IANS=0 IF ALL OK, *-l,...,-4 IF 
SUBROUTINE NOT FOUND (SEE DETAILS UNDER ENTRY WHERE). 



CALL2 (SUBRUV,IANS) FAP, SECONDARY ENTRY OF LOCATE 

IS EQUIVALENT TO CALL SUBR ( ARG1 ... ARGN ) IF SUBRUV WAS FORMED BY 
CALL SETSBV(SUBRU, SUBRUV, ARG1... ARGN) WHERE SUBRU IS PROXY NAME OF 
SJBR. SETS IANS=0 IF ALL OK, =-l,...,-4 IF SUBROUTINE NOT FCUND (SEE 
DETAILS UNDER ENTRY WHERE). 



•**»***••»*•»**»»•*«*•»* 

» CARIGE TO CMPARP * 
»***»»»••••*•*•*»*•»•»•* 



PROGRAM DIGESTS 



***•••»•*»*•»***#«»#•*•* 

» CARIGE TO CMPARP « 
»•»»*«»»••**•*»*•*»••«*» 



CARIGE ( ITAPE, NSPACE) FORTRAN, 47 REGISTERS 

NO OTHER ENTRIES, TRANSFER VECTOR - (STHt,(FILI. 
CAUSES NSPACE SPACES TO BE PRINTED FROM LOGICAL TAPE ITPCUT PROVIDED 
NSPACE GRTHN- 0. IF NSPACE LSTHN= -1 IT CAUSES 1 PAGE RESTORE, 

CHISQR (NBLOCS, ICOUNT,N,CHISQ,IANSI FORTRAN, 105 REGISTERS 

NO OTHER ENTRIES* NO TRANSFER VECTOR. 
SETS CHISQ * SUM(FROM 1=1 TO NBLOCS) OF ( ( 1 /ECNT ) ♦ ( ICOUNT ( I ) -ECNT ) «*2 ) , 
WHERE ECNT=N/NBLOCS, GIVEN N * SUM OF ICOUNT(I). SETS IANS=C IF OK, 
=1 OR = 2 IF ILLEGAL NBLOCS OR N. 



CHOOSE (ZIFRST, X,X1,X2, Y,Y1,Y2, Z,Z1,Z2) FAP, 17 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
IF ZIFRST=0, SETS X=X1, Y*Y1, Z=Z1. IF ZIFRST NOT* 0, SETS 

X=X2, Y=Y2, Z=Z2. MODES OF ARGUMENTS IMMATERIAL. 

CHPRTS (SYM, ANT,N) FAP, 76 REGISTERS 

OTHER ENTRY - RVPRTS. NO TRANSFER VECTOR • 
REVERSES SYMU...LS) AND REVERSES ANTU...LA) CHANGING SIGNS, WHERE 
LS=LA=N/2 IF N EVEN, LS=(N+l)/2 LAMN-D/2 IF N ODD. STRAIGHT EXIT IF 
N LSTHN* 1. 



CHSIGN (X,LX,XNEG) FAP, 18 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XNEGU...LX) = -XU...LX). EQU I V ( X ,XNEG ) OK. STRAIGHT RETURN 
IF LX LSTHN 1. 



CHUSETF(X,X1,X2,ZIFX1) FAP, SECONDARY ENTRY OF INDEX 

PUTS XI (IF ZIFX1 - 0.0) OR X2 (IF ZIFX1 NOT= 0.0) INTO MACHINE 
LOCATION CONTAINING X, THEN SETS ACCUMULATOR * ZIFXi, WHERE MODES 
OF ARGUMENTS IMMATERIAL. 



CLKON FORTRAN, 46 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - CL0CK1 , ( SPH ) , ( FI L > . 
IF THE INTERVAL TIMER IS ON, CONTROL RETURNS IMMEDIATELY. IF NOT, CLKCN 
PRINTS THE ON-LINE MESSAGE QUOTE OPERATOR PLEASE TURN INTERVAL TIMER 
ON UNQUOTE UNTIL THE TIMER IS TURNED ON. 



CL0CK1 (JOB, TIME) FAP (7090), 57 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
FOR JOB=0 CL0CK1 CHECKS TO SEE IF INTERVAL TIMER IS RUNNING, AND LEAVES 
JOB=0 IF RUNNING, SETS J0B=-1 IF NOT RUNNING. FOR J0B=1 CL0CK1 
REMEMBERS PRESENT SETTING OF TIMER. FOR J0B*2 (OR 3) CLCCK1 SETS TIME * 
NO. SECONDS, FLTG, (OR NO. CLOCK COUNTS, FIXED) SINCE LAST CALL OF 
CL0CK1 WITH JOB'l. 



CMPARL (V1,V2,LV,IANS) FAP, SECONDARY ENTRY OF CMPARV 

SETS IANS * *1 IF V1(I)*V2(I) FOR ALL 1=1. . . LV (36 BIT COMPARISON IS 
MADE IN WHICH +0 IS CONSIDERED NOT » -0), OR IANS * -K IF VI (K) 
NOT * V2(K) (COMPARISON ORDER IS 1 , LV , LV-1 , . . . , 2 ) , OR I ANS«0 
IF LV LSTHN 1. 



CMPARP ( IANS,X1,Y1,X2,Y2,...,XN,YN) FAP, 53 REGISTERS 

OTHER ENTRY - CMPARS. NO TRANSFER VECTOR. 
SETS IANS=0 IF X1*Y1 AND X2=Y2 AND ... AND XN*YN, WHERE +0=-0. SETS 
IANS=K IF XK NOT* YK, WHERE K IS LOWEST SUCH INDEX. 



•»•»»•••»•»«•»»»»»«•»»•• 

« CMPARS TO CNTROW » 
•***•»•**»*•****»**••#*• 
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♦ CMPARS TO CNTRGW * 
•**•**«**••••****•****•• 



CMPARS ( IANS,X1,X2,...,XN) FAP, SECONDARY ENTRY OF CMPARP 

SETS IANS*0 IF X1=X2=. . .=XN , WHERE *0=-0. SETS IANS*K IF XK NOT* XK + 1 
WHERE K IS LOWEST SUCH INDEX. 

CMPARV (V1,V2,LV,IANS) FAP, 50 REGISTERS 

OTHER ENTRY - CMPARL. NO TRANSFER VECTGR. 
SETS IANS * +1 IF V1(I)*V2(I) FOR ALL 1*1.. .LX, WHERE 
+0 IS CONSIDERED = -0, OR IANS * -K IF Vi(K| NOT * V2(K) 
(COMPARISON ORDER IS I , LV, LV- 1, . . . , 2 ) , OR IANS*0 IF 
LV LSTHN i. MODE OF VI AND V2 ARBITRARY 

CMPRA F(X1,X2) FAP, 18 REGISTERS 

OTHER ENTRIES - XCMPRA,CMPRFL. NO TRANSFER VECTOR. 
HAS VALUE * 0 IF XI AND X2 ARE IDENTICAL INCLUDING SIGN BIT, 
VALUE * 1 IF XI IS ALGEBRAICALLY GRTHN X2, VALUE * -1 IF 
XI IS ALGEBRAICALLY LSTHN X2 WHERE +0 GRTHN -0 AND MODES OF XI 
AND X2 IMMATERIAL. 

CMPRFLF(X1,X2) FAP, SECONDARY ENTRY OF CMPRA 

HAS VALUE » 0 IF TXl AND TX2 ARE IDENTICAL INCLUDING SIGN BIT, 
VALUE * 1 IF TXl IS ALGEBRAICALLY GRTHN TX2, VALUE * -1 IF 
TXl IS ALGEBRAICALLY LSTHN TX2 WHERE TXl AND TX2 REPRESENT THE 
30 MOST SIGNIFICANT BINARY BITS OF XI AND X2 RESPECTIVELY, 
+0 GRTHN -0, AND MODES OF XI AND X2 IMMATERIAL. 

CNTRDB ( ITAPE,ISENSE,GZFAMP,VOFXY,LXV, FORTRAN, 550 REGISTERS 

LYV,LXDIM,VZERO, SPACE, IANS) 

NO OTHER ENTRIES. TRANSFER VECTOR - SETVECCONTUR, SAME , LOG , EXP , 
(STHI, (FILL 

FORMS 12-INCH (121 COLUMNS) BY 24-INCH (145 ROWS) CONTOUR PLOT ON 
LOGICAL ITAPE FROM MATRIX VOFXY( 1 . . .LXV, 1 . . .LYV ) , FOR WHICH USER HAS 
DIMENSION VOFXYUXDIM, IGNORD), VOFXY( 1 ...LXV,1 ) BECOMING FIRST 
OUTPUT ROW AND V( 1 . . .LXV, LYV ) LAST. BUILT IN CONTOUR LEVELS ARE 
PRINTED OUT. PLOT IS MADE OF 20*LOG ( VOFXY/VZERO ) IF GZFAMP GRTHN 
0., OF 10*LGG(V0FXY/VZER0) IF GZFAMP * 0., OR OF VCFXY IF GZFAMP 
LSTHN 0. IF ISENSE * 1...6, ON-LINE MONITORING OF PLOT OCCURS WHILE 
SENSE SWITCH ISENSE IS DEPRESSED. SPACE! 1. . . 204+LXV+XMAX0F (4,484/LXV )) 
NEEDED FOR SCRATCH. LXV AND LYV MUST EXCEED 1, LXDIM GRTHN* LXV, 
AND VZERO NOT* 0 IF GZFAMP GRTHN* 0. SETS IANS * 0 IF OK, 
= -1,-2,-3,-4 IF LXV, LYV, LXDIM, OR VZERO ILLEGAL, * -100+K IF 
CONTUR FLAGS ERROR WITH ITS IANS * K. 

CNTROW (VEC,LVEC,FXLO,FXHI,NCOLS,CHLVLS,NCHRS, FORTRAN, 802 REGISTERS 

DELEVL ,VL£VL , SPACE, PLOTVC, IANS) 

NO OTHER ENTRIES. TRANSFER VECTOR - CUFIT1 , QUF IT1 , FASCUB ,RND, 
RNDDN, RNDUP. 

SETS PL0TVC(1...NC0LS) WITH BLANKS, WITH CHARACTERS SELECTED FROM 
CHLVLSU...NCHRS), AND POSSIBLY WITH * OR $ CHARACTERS, TO INDICATE 
APPROXIMATE POSITIONS OF SPECIFIED LEVELS OF VALUES OF A SUBSECTION OF 
VECU...LVEC), THE SUBSECTION BEING SYMBOLIZED BY VEC ( FXLO. . .F XH I ) 
WHERE FXLO, FXHI MAY BE FRACTIONAL. CUBIC INTERPOLATION IS USED. IF 
DELEVL*0. THEN VLEVL (1. . .NCHRS ) SPECIFIES LEVELS CORRESPONDING TO THE 
1A6 FORMAT CHARACTERS IN CHLVLS. IF DELEVL GRTHN 0., VLEVL IS 
SIMPLE VARIABLE, CONTOUR LEVELS ARE VLEVL PLUS OR MINUS MULTIPLES CF 
DELEVL, AND ASSOCIATION OF CHLVLS ( 1 ... NCHRS ) WITH VLEVL, 

(CONTINUED NEXT PAGEI 



•*•»••»»*»•»•••»»*»••*»• 

* CNTROW TO CONTUR « 



PROGRAM DIGESTS 
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* CNTRCW TO CONTUR « 
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VLEVL+DELEVL, ... IS PERIODIC. » IS USED TO INDICATE 2 LEVELS 
CROWDING 1 COLUMN, $ FOR 3 OR MORE. REQUIRE LVEC GRTHN* 2, 
FXLO GRTHN* 1.0, FXHI GRTHN FXLO AND LSTHN* FLOATF CLVECI , NCOLS 
GRTHN* 2, NCHRS GRTHN* 1, DELEVL GRTHN- 0., VLEVLU + l) GRTHN 
VLEVL(I) FOR CASE DELEVL * 0., AND SPACE ( 1 . . . 2+MAXOF (4,4«NC0LS/L I) 
BE AVAILABLE FOR SCRATCH WHERE L * FXHI ROUNDED UP - FXLO RCUNDEO DOWN. 
SETS IANS =0 IF OK, ■ -1,-2, • • . ,-7, IF LVEC, FXLO, FXHI , NCOLS, NCHRS, 
DELEVL, VLEVL ILLEGAL. 



COLABL (ITAPE, ICOLLO, NCOLLO, NCOLS, ISPACE) FORTRAN, 185 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - GENHOL, (SPHI , CFILI , (STH1. 
PRINTS THREE LINES ON LOGICAL ITAPE USING COLUMNS ICOLLO THRU 
ICOLLO+NCOLS-l, COLUMN ICOLLO DISPLAYING THE 3-DIGIT INTEGER NCOLLC, 
COLUMN ICOLLO+1 DISPLAYING NCOLLO+1, ETC. REQUIRE I SPACE ( 1. ..NCCLS) 
FOR SCRATCH, ALL INPUTS GRTHN* 1 EXCEPT EXCEPT NCOLLO GRTHN* 0, 
AND ITAPE LSTHN* 20 . ONLY CHECK ITAPE GIVING STRAIGHT RETURN IF 
ILLEGAL. 



COLAPS (X,N,TYPE,XC,M) FAP, 50 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XCU...M) FROM XC1...N), WHERE XC ( I) * X ( I ) +X ( I *M )*X(I+2M ) 
♦ IF N EXCEEDS M, XCU...N) * X(1...N) AND XC1N+1...M) * 0 

IF N LSTHN* M. TYPE*0. MEANS X FXD. , NOT*G. IF FLTG. 



CONTUR ( ITAPE, ISENSE, VOFXY,LVX, LVY,LXDIM, FXLO, FORTRAN, 587 REGISTERS 

FXHI, NCOLS, NCOLLO, FYLO, FYHI ,NROWS, ARGLO, 
ARGDEL , ZFAFXD, CHLVLS , NCHRS , DELEVL , VLEVL , 
SPACE, IANSI 

NO OTHER ENTRIES. TRANSFER VECTOR - RNDDN, RNDUP , COLABL , ARBCOL , 

CNTROW,XSAME, <STH) ,( FID, (SPH), SWITCH. 
STARTS WITH PAGE RESTORE AND FORMS A CONTOUR PLOT ON LOGICAL ITAPE 
(VALUE I TO 201 OCCUPYING (EXCLUSIVE OF LABELLING! NCOLS (2 TO 1191 
COLUMNS AND NROWS (GRTHN* 2) ROWS, OF AN ARBITRARY RECTANGULAR SUBSET 
OF MATRIX V0FXY(1...LVX,1...LVY) (WITH LVX, LVY GRTHN* 2) FOR 
USER HAS DIMENSION VOFXY( LXDIM, IGNGRD) (WITH LXDIM GRTHN* LVXI, 
WHERE THE SUBSET IS SYMBOLIZED BY VOFXY (FXLO. .. FXH I , FYLO. .. FYHI 1 , 
FXLO, FXHI, FYLO, AND FYHI BEING NOT-NECESSARILY-INTEGRAL INDICES 
SATISFYING 1.0 LSTHN* FXLO LSTHN FXHI LSTHN* FLOATF (LVX) AND 
1.0 LSTHN* FYLO LSTHN FYHI LSTHN* FLOATF (LVY) , AND WHERE THE 
FIRST OUTPUT ROW IS FOR VOFXY(FXLO. . .FXHI , FYLO) . CUBIC INTERPOLATION 
IS USED IN FINDING POSITIONS OF CONTOUR LEVELS. COLUMNS ARE LABELLED 
FROM NCOLLO (VALUE 0 TO 1000-NCOLS) TO NCOLLO+NCGLS-1 . ROWS ARE 
LABELLED ARGLO, ARGLO+ARGDEL ,.. . WHERE ZFAFXD * 0 OR NOT* 0 
INDICATES ARGLO, ARGDEL FIXED OR FLOATING RESPECTIVELY. 
CHLVLSd... NCHRS) (WITH NCHRS GRTHN* 1) ARE FORMAT ( 1 A6) CHARACTERS 
TO USE FOR CORRESPONDING CONTOUR LEVELS. IF DELEVL * 0., THEN 
VLEVLd. ..NCHRS) (MUST BE MONOTONELY INCREASING) ARE THE LEVELS. IF 
DELEVL GRTHN 0. (MUST NOT BE LSTHN 0.), THEN VLEVL IS SIMPLE 
VARIABLE, CONTOUR LEVELS ARE VLEVL PLUS OR MINUS ALL INTEGRAL 
MULTIPLES OF DELEVL, ANO ASSOCIATION OF CHL VLS ( 1 ... NCHRS ) WITH 
VLEVL, VLEVL+DELEVL, • • • IS PERIODIC. * IS USED TO INDICATE 2 LEVELS 
CROWDING ONE PRINT POSITION, $ FOR 3 OR MORE. REQUIRE 
SPACEd...L+NC0LS*3*XMAX0F(4,4*NC0LS/L) ) FOR SCRATCH WHERE L * FXHI 
ROUNDED UP - FXLO ROUNDED DOWN. SETS IANS * 0 IF OK, * - 1 ,-2 , . . . ,-9 , 
-10,-105,-106,-107 FOR ILLEGAL I TAPE , LVX, LVY , LXDIM , FXLO, FXHI , NCOLS , 
FYLO, FYHI, NROWS, NCHRS, DELEVL, VLEVL. 
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* CONVLV TO COSTBX « 
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CONVLV (LX,XX,LY,YY,CC) 



FORTRAN, 96 REGISTERS 



NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS CCU...LXH.Y-1) * C ( 0. . . LX+LY-2 > WHERE C(I) * SUMCFROM J=0 TO LX-1) 
OF (X( J)*Y( I-J) ) GIVEN X(0...LX-1) IN XXU...LX) AND Y(C.LY-i) IN 
YYU...LY), AND ASSUMING Y(K)*0 FOR K OUTSIDE RANGE 0...LY-1. STRAIGHT 
RETURN IF LX OR LY LSTHN* 0. EQUIV(XX,YYI OK. 

CONVLV (LX,XX,LY,YY,CC) -II FAP, 56 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SAME FUNCTION AS FORTRAN VERSION OF CONVLV. 

COSISP ( SSXt ASXySAXf AAXf L tCOSTABt S INTABtMt FAP f SECONDARY ENTRY OF COSP 

JMIN, J MAX, TYPE, COSTR, SINTR ) 
SETS COSTR(I) AND SINTRCII, 1*1. . . JMAX-JMIN+1 , IN SAME WAY THAT 
CALL COSP (SSX, ASX,L,COSTAB, M f JMIN, JMAX, TYPE , COSTR ) 
CALL SISP (SAX,AAX,L,SINTAB,M, JMIN, JMAX, TYPE, SINTR) 
WOULD SET THEM. EGUIV (SSX, A SX, SAX, AAX) OK. 

COSISL ( JOB, X,LX,COSTAB,SINTAB,MFREQ, JMIN, FORTRAN, 406 REGISTERS 

JMAX,COSTR,SINTR,ZIFSTO,SPACE,IANS) 

NO OTHER ENTRIES. TRANSFER VECTOR - IXCARG, SPLIT, MOVRE V,CHPRTS , 
COSP, SISP, COSISP. 
SETS COSTR(I), 1 = 1... JMAX-JMIN+1, IN SAME WAY THAT 

CALL COSPU, X, LX-1, COSTAB, MFREQ, JMIN, JMAX, 1., COSTR) 
WOULD SET IT IF J08=l OR *3 . SETS SINTR(I), 
I*1...JMAX-JMIN*1, IN SAME WAY THAT 

CALL SISPtX, X, LX-1, SINTAB, MFREQ, JMIN, JMAX, 1., SINTRI 
WOULD SET IT IF J0B=2 OR = 3 . IF COSINE OR SINE TRANSFORM NOT 
WANTED, ARGUMENTS ASSOCIATED WITH IT ARE DUMMIES. LX MUST BE ODD. 
ZIFSTO*0. IMPLIES STORE COSTR AND/OR SINTR, NOT* 0. IMPLIES ADO 
VALUES INTO OUTPUT AREAS. SPACE ( 1 .. .LX+3 ) IS SCRATCH. EQUIVALENCE 
(X, SPACE) OK. SETS IANS * 0 IF NO ILLEGAL INPUTS, * ARGUMENT 
NUMBER IF IT IS ILLEGAL. 

COSP (SSX, ASX,L, COSTAB, M, JMIN, JMAX, TYPE, COSTR) FAP, 504 REGISTERS 

OTHER ENTRIES - SISP, COSISP. NO TRANSFER VECTOR. 
SETS C0STR(1...JMAX-JMIN+1) * CT( JMIN. .. JMAX ) WHERE CT(J) * SUM (FROM 
1*0 TO L) OF (X( I)»COS( I»J*(PI/M)I ) AND X(O...LI * SSXU...L + 1I FOR 
J EVEN, = ASX(1...L*1) FOR J ODD. COSTAB( 1. ..M+l ) IS INPUT TABLE 
CONTAINING COS(I»PI/M) 1*0. ..M . TYPE = 0.0 SIGNIFIES SSX, ASX AND 
COSTAB FXD.PT., NOT * 0.0 SIGNIFIES FLTG.PT. EQUI V( SSX, ASX) OK. 
IF M NEGATIVE, ITS MAGNITUDE IS USED AND CTI...I IS ADDED INTO 
COSTR(...) RATHER THAN STORED INTO IT. STRAIGHT RETURN IF L LSTHN* 0, 
OR M=0, OR JMIN LSTHN 0, OR JMAX LSTHN* JMIN OR GRTHN M. 

COSTBL (N, COSTAB) FAP, 121 REGISTERS 

OTHER ENTRIES - SINTBL, COSTBX, S INTBX. TRANSFER VECTOR - COS, SIN. 

SETS C0STABU...N+1) * COS(I»PI/N) 1*0. ..N. STRAIGHT RETURN IF 
N LSTHN* 0. 

COSTBX (N,ICOSTB) FAP, SECONDARY ENTRY OF COSTBL 

SETS ICOSTB( 1...N+1) * COS(I*PI/N) 1*0. ..N, WHERE ICOSTB IS FXD.PT. 

(BINARY PT BETWEEN SIGN AND BIT 1), AND 1.0 * OCT 377777777777. STRAIGHT 
RETURN IF N LSTHN* 0. 



•*•»•*•«****•»•*****»*•* 

* CPYFL2 TO CUFIT1 • 
***»***»»«»**•»»»****••• 



PROGRAM OIGESTS 



#**•••*»•*••«»**•«••*••* 

♦ CPYFL2 TO CUFIT1 ♦ 
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CPYFL2 (ITPIN, I T POUT, LRECMX, ZF EOF W , SPACE , I ANS) FAP, 178 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - ( IGS ) , ( TCO ) , ( WRS ) , (RCH ) , ( TRC ) , 
{ ETTI f ( WEF ) t { BSRI , (RDS). 
COPIES ONE FILE (BINARY OR BCD) OF RECORDS OF LENGTH LSTHN* LRECMX 
FROM LOGICAL TAPE ITPIN TO LOGICAL TAPE ITPOUT. IF ZFEOFW - Ot 
THE END-OF-F ILE MARK IS ALSO COPIED, OTHERWISE NO END-OF-FILE MARK IS 
PLACED ON ITPOUT. SPACE < 1 .2*LRECMX \ NEEDED FOR SCRATCH. IF RECORDS 
ARE LONGER THAN LRECMX, THEY ARE TRUNCATED. SOME TYPICAL FORTRAN- 1 1 
RECORD LENGTHS ARE BCD CARDS - 14 WORDS, BCD OUTPUT RECORDS - 22 
WORDS, PACKED BCD OUTPUT RECORDS - 66 WORDS, BINARY CARDS - 27 WORDS, 
BINARY OUTPUT RECORDS - 256 WORDS. SETS IANS * 0 IF ALL OK, = 1, 2, 
OR 3 IF PERMANENT REDUNDANCY ON ITPIN, ITPOUT, OR BOTH, * 4, 5, 

15 IF END TAPE AND ALSO POSSIBLE REDUNDANCIES ENCOUNTERED ON 
ONE OR BOTH UNITS. SEE WRITEUP. 

CROSS (LX,X,LY,Y,LC,C) FORTRAN, 1C7 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - FDOT,STZ. 
SETS CU...LC) = XCOR(O...LC-1) WHERE XCOR(K) = SUM (FROM 1 = 1 TO 
LX) OF (X(II*Y(I-K)> WHERE Y IS TAKEN TO BE ZERO OUTSIDE ITS 
RANGE. ROUTINE RETURNS WITH NO COMPUTATION IF LX, LY, LC LSTHN 1 . 
EQUIVALENCE (X,Y) OK. 

CROST UX,X,LY,Y, ILAG,LC,C) FORTRAN, 134 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - CROSS, REVERS. 
SETS CI1...LC) * XCOR(ILAG,...,ILAGHX-l) WHERE XCOR(K) * SUM 
(FROM 1 = 1 TO LX) OF ( X ( I ) »Y ( I-K ) ) , WHERE Y IS TAKEN = 0.0 
OUTSIDE ITS RANGE. ROUTINE RETURNS WITH NO COMPUTATIONS IF LX, LY, 
LC LSTHN 1 . EQUIVALENCE (X,Y) OK. 

CRSVM (NRAC,NCARB,NCBC,LA, AA,LB,BB,Z IFNTR, I LAG, LC, CO FORTRAN, 327 REGISTERS 
NO OTHER ENTRIES. TRANSFER VECTOR - MD0T3, STZ , SETKS. 
SETS CC(1...NRAC*NRBC»LC) = C ( IL AG. . . IL AGHX- 1 ) WHERE C(K) = SUM (FROM 1=1 
TO LC) OF MATRIX PRODUCT OF A(I) AND B(l-K), WHERE C(I) IS THE NRAC X NCBC 
MATRIX STORED BY COLUMNS BEGINNING AT CC ( 1+NRAC»NCBC« ( 1-1 ) ) , A(I) IS THE 
NRAC X NCARB MATRIX STORED BY COLUMNS BEGINNING AT A A ( 1+NRAC* NCARB* ( 1-1 ) ) , 
AND B(IJ IS THE NRAC8 X NCBC MATRIX STORED BY COLUMNS, IF ZIFNTR=0., GR BY 
ROWS, IF ZIFNTR NOT* 0., BEGINNING AT BB ( 1+NR ACB*NCBC« ( 1-1 ) ) . B(I) IS 
TAKEN TO BE 0.0 OUTSIDE ITS RANGE. NO COMPUTATIONS ARE MADE (CC MAY BE 
SET TO ZERO) IF NRAC, NCARB, NCBC, LA, LB, LC LSTHN 1 . EQUIVALENCE (AA,BB) CK. 

CSOUT (ITAPE,NSPACE,C1,C1NAME,C2,C2NAME,...,CN,CNNAME) FAP, 49 REGISTERS 
NO OTHER ENTRIES. TRANSFER VECTOR - CARIGE,HRADJ , ( STH) , (FI L) . 
OUTPUTS C1NAME,C1, C2NAME,C2, CNNAME,CN ON LOGICAL OUTPUT TAPE 

ITAPE ACCOROING TO THE FORMAT (5(2X, A6, 3H * , G14.7)) PRECEDED BY 
NSPACE SPACES (OR PAGE RESTORE IF NSPACE LSTHN 0). 

CUFIT1 (FOFX,XLO,DELX,COEFS) FAP, 158 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS C0EFS(1...4) = C0,C1,C2,C3 SUCH THAT G(X) = CO ♦ C1*X ♦ C2»X*»2 
+ C3*X**3 SATISFIES G(XLO) » FOFX(l), G(XLO*DELX) » FCFX(2), 
G(XLQ+2*DELX) * F0FX(3), G( XL0*3»DELX ) = F0FX(4) . STRAIGHT RETURN 
WITH NO OUTPUT IF DELX « 0. 
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* CVSOUT TO DIFPRS » 
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CVSOUT (ITAPE, NSPACE, FMTHED,FMTLIN,ILO,IHI, FAP, 84 REGISTERS 

ARGLO, ARGDEL, SPACE, XI ,X2, . . . , XN ) 

NO OTHER ENTRIES. TRANSFER VECTOR - CAR I GE , FMTGUT , VECOUT. 
OUTPUTS N VECTOR RANGES, XI { ILO. . . IH I ) , X2 < I LO. • • IHII , . . . , XN ( I LO. . . I H 1 I , 
IN COLUMN FORMAT, INSERTING FIRST COLUMN ARG = ARGLO, ARGLO+ARGDEL , 
ARGL0+2»ARGDEL,..., ONTO LOGICAL TAPE ITAPE WITH NSPACE INITIAL SPACES 
(OR PAGE RESTORE IF NSPACE LESS THAN 0). FMTHED(I) IS A NORMLIT FORMAT 
VECTOR (AS DEFINED BELOW) FOR HEADING THE COLUMNS AND FMTL IN ( 1 1 IS A 
NORMLIT FORMAT VECTOR FOR PRINTING THE SUCCESSIVE LINES (MUST INCLUDE 
PRINTING OF ARG, ALWAYS FLOATING). SPACE( i. . .N+l ) NEEDED FOR SCRATCH. 
DEFINITION - A NORMLIT FORMAT VECTOR IS EITHER 

A) A NORMAL FORMAT VECTOR 
OR B) LITERAL HOLLERITH IN A CALLING SEQUENCE WHOSE CHARACTERS 
(READING CONTINUOUSLY FROM LEFT TO RIGHT) ARE THE DESIRED 
FORMAT STRIPPED OF THE ENCLOSING PARENTHESES. THE FIRST AND 
SECOND CHARACTERS MUST NOT BE QUOTE ( UNQUOTE OR QUOTE I 
UNQUOTE RESPECTIVELY. (TWO BLANKS FOLLOWED BY ( WOULD BE OK.) 

DADECK (ITPIN,ITPOUT) FORTRAN, 100 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - EOFSET , RSK IP , ( TSH) , (RTN) , 
(STH),(FIL). 

COPIES SUCCESSIVE CARD IMAGES (COLUMNS i THRU 80) FROM LOGICAL TAPE 
ITPIN ONTO LOGICAL TAPE ITPOUT (COLUMNS 2 THRU 81) UNTIL 
END-OF-FILE REACHED ON ITPIN. THEN BACKSPACES ITPIN TO ORIGINAL 
POSITION. 

DELTA F ( ARG) FAP, 17 REGISTERS 

OTHER ENTRIES - XDELTA, STEPR, XSTEPR , STEPL , XSTEPL , STEPC , XSTE PC. NO 
TRANSFER VECTOR. 

HAS VALUE = 1.0 IF ARG (ANY MODE) * ZERO. OTHERWISE HAS VALUE 
* 0.0 



DERI VA ( YOFX ,L Y,DELX, DYDX, YOFXi ) FAP, 61 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS DYDX(l) = (Y0FX(2)-Y0FX(1) )/DELX, AND (IF LY GRTHN 2) 
DYDX(K) » (Y0FX(K+1)-Y0FX(K-1)/(2.0*DELX) FOR K=2...LY-1, 
AND DYDX ( LY ) * ( Y0FX(LYI-Y0FX(LY-1 ) ) /DELX, AND Y0FX1=Y0FX ( 1 ) . 
EQUIV(DYDX,YOFX) OK. STRAIGHT RETURN IF LY LSTHN 2 OR 
DELX » 0. (BUT MAY BE NEGATIVE). FUNCTION IS EXACT INVERSE 
TO THAT OF IDERIV. 



DETRM ( N, LN, A , D, ERR ) FAP, SECONDARY ENTRY OF SIMEQ 

SETS D = CONSTANT*DETERMINANT OF MATRIX A(I,J) I,J=1...LN WHERE N 
IS USERS DIMENSION OF I (2 LSTHN* LN LSTHN*N), AND CONSTANT = INPUT 
VALUE OF D. SETS D » 0.0 IF A SINGULAR. SETS ERR = 0.0 IF OK, 
NON SINGULAR, =1.0 IF OVER OR UNDERFLOW, = 2.0 IF SINGULAR. A(I,J) 
DESTROYED. 

DIFPRS (X,LX, XPRSDF) FAP, 30 REGISTERS 

OTHER ENTRY - XDFPRS. NO TRANSFER VECTOR. 
SETS XPRSDF(1)=X(1), XPRSDF ( I )=X( I )-X ( 1-1 ) FOR 1=2. ..LX. 
EQUIV(XPRSDF,X) OK. STRAIGHT RETURN IF LX LSTHN 1. 
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* DISPLA TO DOTP ♦ 



* DISPLA TO DOTP » 
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**«*»»*»*»••»•»•**•••«*• 



DISPLA 



FAP (709) , 220 REGISTERS 



NO OTHER ENTRIES. 



TRANSFER VECTOR 



(IGH). 



FAP (70901, 219 REGISTERS 



NO OTHER ENTRIES. TRANSFER VECTOR - (IGH), FRAME. 
THE SEQUENCE CALL DISPLA - PRINT FMT, LIST - FMT FORMAT (NHMCDX,Y, 
FMTEND) FUNCTIONS LIKE PRINT FMT, LIST - FORMATC FMTENDI , WHERE FMT - 
STATEMENT NO. OR VARIABLE NAME CONTAINING THE FORMAT. N * CHARACTER 
COUNT FROM M TO FMTEND. C * 8 OR S FOR 8IG OR SMALL CHARACTERS 
(BIG CHAR * 20»28 (36 ACROSS SCOPE), SMALL * 15»21 (48 ACROSS SCOPE)), 
D * H OR V FOR HORIZONTAL OR VERTICAL DISPLAY. X,Y * 2 INTEGERS FOR 
SCOPE COORDINATES OF LOWER LEFT CORNER OF FIRST CHARACTER. M * 2 
MEANS SET FOR NEW CDX,Y, AND SINGLE SPACING. M=l SAME AS M=2 BUT 
CHANGE FRAME FIRST. M = ♦ MEANS USE PREVIOUS M * 1 OR 2 MODE (CDX,Y NOT 
PRESENT). M - O(ZERO) SAME AS = ♦ BUT DOUBLE SPACE. M * (BLANK) 
SAME AS M * ♦ BUT SINGLE SPACE. NHMCDX, Y, MUST BE TIGHT PACKED. 

DIVIDE (X,LX,XDVSR,XDVDED) FAP, 23 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XDVDED(1...LX) * X( 1. . .LX)/XDVSR. EQU IV ( X , XDVDED ) OK, AND 
EQUIVUDVSR, SOME X(I)) OK, BUT INITIAL VALUE OF XDVSR IS ALWAYS THE 
DIVISOR. STRAIGHT RETURN IF XDVSR*0.0, OR LX LSTHN 1. 

DIVK (C,X1,X2,...,XN) FAP, SECONDARY ENTRY OF ADCK 

SETS X1*X1/C, X2*X2/C, XN*XN/C. EQUI V ( ANY ARGUMENTS) OK, BUT 

INITIAL VALUE OF C IS ALWAYS THE DIVISOR. STRAIGHT RETURN IF C*0.0, 
OR N*0. 

DIVKS (C1,X1,Y1,C2,X2,Y2,...,CN,XN,YN) FAP, SECONDARY ENTRY OF ADCK 

SETS Yl*Xi/Cl, Y2*X2/C2, YN*XN/CN. EQUIV(ANY TWO ARGUMENTS ) 

OK BUT MAY CHANGE INPUTS CJ OR XJ. PROCESSING IS LEFT tO RIGHT. 
YJ IS NOT COMPUTED IF CJ*0 AT COMPUTATION TIME. 
STRAIGHT RETURN IF N=0. 

DO (NSUBS,I,ILO,IHI) FAP, PSEUDO ENTRY OF SEVRAL 

USAGE IS CALL SEVRAL ( . . . ,2HD0,NSUBS, I , ILO, IHI ,. . . ) . FUNCTION 
IS SIMILAR TO THE FORTRAN STATEMENT DO NSUBS I*ILG,IHI WHEN 
NSUBS (MUST EXCEED ZERO) IS THE NO. OF SUBROUTINES (IMMEDIATELY 
FOLLOWING THE 2HD0 SEQUENCE) IN THE DO LOOP. ILO MAY BE NEGATIVE, OR 
ZERO. LOOPS WITHIN LOOPS EXCLUDED. PSEUDO IF STATEMENT IN LOOP 
EXCLUDED. 

DOTJ (LXY,IDX,X,IDY t Y, DOT, ADD, ORDER) FAP, 59 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS DOT*DOTP IF ADD LSTHN* 0, *DOT+DOTP IF ADD GRTHN 0, WHERE DOTP * 
X(1)*Y(1)*X( 1 + IDX)*Y(1MDY)+XU+2MDX)*Y(1*2MDY)+...*X(1+(LXY-1)»IDX)« 
Y(1+(LXY-1)*IDY) IF ORDER GRTHN 0, AND DOTP * X( 1 I *Y( 1* (LXY-1 )* IDY) ♦ 
...+X(l+(LXY-l)*IDX)»Y(l) IF ORDER LSTHN* 0. IDX MUST BE GRTHN* 0, 
IDY MUST BE GRTHN* 1 . 

DOTP (NRA,NCA, AA,NRB,NCB,BB , IRB, ICB , DOT, ORDER ) FORTRAN, 264 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - DOTJ. 
SETS DOT * SUM (FROM 1*1 TO NRA) OF SUM (FROM J=i TO NCA) OF 
( AA(IH-( Jl-l)*NRA) » 8B( I*IRB*( J+ICB-1 ) »NRB ) ) WHERE IF 0RDER*1. , 

(CONTINUED NEXT PAGE) 



••»*••»*•••••*••*••«•«•• 

» DOTP TO EXCHVS * 
*»»»•»»*•*»»•»•*••»*»*•« 



PROGRAM DIGESTS 



****•»••*•*•••»•••**•••• 

♦ DOTP TO EXCHVS • 
••*•»*••»•»*»•*•••••»•** 



1 1*1 ♦ Jl=Jt IF ORDERS., Il=NRA-i+l, J1 = J, IF ORDER*-l., 11*1, 
J1=NCA-J*1, AND IF ORDER—2., I1*NRA-I*1 9 J1«NCA-J+1 . B8 IS 
TAKEN AS 0. OUTSIDE ITS RANGE. AA IS AN NRA BY NCA ARRAY STORED 
CLOSELY SPACED BY COLUMNS, BB IS AN NR8 BY NCB ARRAY STORED BY 
COLUMNS. DOT*0. IF NRA, NCA, NRB, NCB LSTHN 1 . EQUIVALENCE 
( AA, BB) OK. 

DPRESS (X,LX,XSINK,XLWRD) FAP, SECONDARY ENTRY OF BOOST 

SETS XLWRDU...LX) * X< 1 • • • LX )-XS INK. EQUIV(X,XLWRD) OK, AND 
EQUIVCXSINK, SOME X(I)) OK, BUT INITIAL VALUE OF XSINK IS ALWAYS THE 
SUBTRAHEND. STRAIGHT RETURN IF LX LSTHN 1. 

DSPFMT (CNTHOL, IORGX, 10RGY ,FMTEND» FMT ) FAP, 194 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS FMT(1,2,...) * FORMAT SUITABLE FOR SUBROUTINE DISPLA, WITH 
DESIRED SCOPE ORIGIN X * IORGIN, Y=IORGY , WHERE CNTHOL « DESIRED 
CONTROL CHARACTERS M, C, D OF DISPLA IN FORMAT (1A3), AND 
FMTEND(1,0,-1,...) IS LITERAL HOLLERITH ARGUMENT GIVING FORMAT FOR 
PRINTING LIST (EXCLUDES EXTREMAL PARENTHESES I . 

DUBLL CX,LX) FAP, SECONDARY ENTRY OF DU8LX 

SETS XU...LX) = 2.G*X( 1...LX). MAGNITUDE OF LX IS USED AND LX*0 
TREATED AS LX=1 . 

DUBLX (IX, LX) FAP, 45 REGISTERS 

OTHER ENTRIES - DUBLL, HALVX,HALVL. NO TRANSFER VECTOR. 
SETS IXU...LX) « 2»IX(1...LX). MAGNITUDE OF LX IS USED AND LX«0 
TREATED AS LX*1 . 

ENDFIL (ITAPE) (FORTRAN FUNCTION) FAP, SECONDARY ENTRY OF REREAD 

CHECKS AN INTERNAL FLAG OF REREAD. IF EOF SET WAS CALLED WITH 
ZIFTRN'l. AND IF AN END-OF-FILE WAS ENCOUNTERED, ENDFI LF C ITAPE)=1. 
AND ITAPE * LOGICAL TAPE NUMBER THAT THE END-GF-FILE WAS 
ENCOUNTERED ON. OTHERWISE ENDFILF ( ITAPE)=0. THE FLAG IS RESET AFTER 
EACH USE OF ENDFIL. 

EOFSET (ZIFTRN, EOF, ITAPE) FAP, SECONDARY ENTRY OF REREAD 

INSTRUCTS REREAD ON THE ACTION IT SHOULD TAKE IF AN END-OF-FILE IS 
ENCOUNTERED WHILE READING. IF ZIFTRN=-i. REREAD WILL CALL EXIT, 
IF =0. REREAD WILL RETURN CONTROL TO THE FIRST STATEMENT FOLLOWING 
THIS 'CALL EOFSET 1 STATEMENT WITH E0F«1. AND I TAPE * LOGICAL TAPE 
UNIT THAT THE END-OF-FILE WAS ENCOUNTERED ON, IF =1. REREAD WILL 
SET AN INTERNAL FLAG (THAT MAY BE CHECKED BY FUNCTION ENDFIL) AND 
INTERPRETS THE END-OF-FILE AS A RECORD OF BLANKS. EOF»0., ON NORMAL 
RETURN FROM EOFSET. 

EXCHVS (LXY,X,Y) FAP, 22 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS YU...LXY) * INPUT VALUES OF XU...LXY), AND XU...LXY) « 
INPUT VALUES OF YU...LXY). EQUIV(X,Y) OK. STRAIGHT RETURN IF 
LXY LSTHN 1. 



•**•*••*»»*»•*•»«»*•**»* 
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* EXPANO TO FASEP1 » 



♦ EXPAND TO FASEP1 • 



•**»•»••#••»»»*»»»**»*•* 



*•••*»»«•»*«*»»•••*•»•*« 



EXPAND (X, LX,MLPLYR,XPNDED,LXPNDD) 



FAP f 189 REGISTERS 



NO OTHER ENTRIES, TRANSFER VECTOR - INTOPR. 
SETS LXPNDD » ILX-1 )»MLPLYR+1, SETS XPNDEDU, 1+MXPLYR , 1+2*MLPLYR , . . . , 
LXPNDD) - XU...LX), AND SETS THE INTERMEDIATE VALUES (FOR THE CASE 
MLPLYR GRTHN- 2) OF XPNDED BY CUBIC INTERPOLATION (REDUCED TO 
QUADRATIC AT THE ENDS OR TO LINEAR IF LX = 2). STRAIGHT RETURN WITH NO 
OUTPUT IF LX LSTHN* 0, OR IF LX GRTHN- 2 BUT MLPLYR LSTHN* 
0 . IF LX * 1 MLPLYR IS IGNORED. 

FACTOR (SPECT f N,L,WAVE, SPACEI FAP, 308 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - MAXAB,COSTBL ,COSP, LOGt EXP. 
SETS WAVEU...L) * MINIMUM PHASE WAVELET WITH GIVEN ENERGY DENSITY 
SPECTRUM, SPECTU...N) , CORRESPONDING TO FREQUENCY RANGE 0 TO PI ( ZERO 
LSTHN L LSTHN* Nl. SPACE ( 1. . . 3»L+N+ I ) NEEOED FOR SCRATCH. 
EQUIV(WAVE,SPECT) OK. 

FAPSUM (LD,DATA,SUMCK) FAP, 14 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS SUMCK * LOGICAL SUM OF DATAU...LD) (USING ACL INSTRUCTION) 

FASCN1 (VECT, ILO,IHI, VALUE, IFIND,IANS) FAP, 107 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SCANS VECTULO...IHI) LOOKING FOR FIRST ELEMENT IF ANY WHICH IS GRTHN* 
VALUE. SETS IANS*0 IF NONE, SETS IFIND AND IANS*1 IF VECT( IFIND) 
GRTHN=VALUE. SETS IANS*-2 OR -3 IF ILLEGAL ILO OR IHI (1 LSTHN* 
ILO LSTH*IHI). VECT AND VALUE EITHER BOTH FLTG. PT. OR BOTH FXD. PT. 

FASCOR (Y, KMIN, KMAX, CORZER, ERROR) FAP, SECONDARY ENTRY OF PRCCCR 

SETS C0RZER(-KMN+1...KMAX+1) - XCORI-KMN.. .KMAX) WHERE XCOR(K) * SUM 
(FROM 1*1 TO LX) OF ( X ( I ) *Y ( I+K ) ) I.E. ZERO LAG GOES IN CORZER(l) 
AND WHERE 1) X AND LX WERE THE ARGUMENTS OF A PRIOR CALL PROCOR 
STATEMENT, 2) KMN=MAGN ITUDE OF KM IN, 3) -LX LSTHN KMIN LSTHN* 0 
LSTHN* KMAX LSTHN LX, 4) Y IS TAKEN TO BE * 0 OUTSIDE RANGE 
1...LX, AND 5) Y,X, AND CORZER ARE MACHINE LANGUAGE INTEGERS. SETS 
ERROR * 0 IF OK, = 1.0 IF NO PREVIOUS CALL PROCOR, * 2.0 IF 
ILLEGAL KMIN OR KMAX, * 3.0 IF OVERFLOW OCCURS. 

FASCRi (Y, KMIN, KMAX, CORZER, ERROR) FAP, SECONDARY ENTRY OF PROCCR 

FUNCTIONS IDENTICALLY TO SUBROUTINE FASCOR EXCEPT THAT THE 
CORRELATION IS ADDED INTO THE OUTPUT AREA RATHER THAN BEING STORED INTO 
IT. 

FASCUB (COEFS,XLO,DELX,NF,FOFX) FAP, 141 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS F0FX(1...NF) = F(XLO), FIXLO+DELX), F( XLO-M NF-1 ) »DELX ) WHERE 

F(X) = CO ♦ C1»X ♦ C2*X**2 ♦ C3»X»»3 WHERE C0,C1,C2,C3 GIVEN BY 
CGEFSU...4). STRAIGHT RETURN WITH NO OUTPUT IF LX LSTHN* 0 . 

FASEPC (Y, KMIN, KMAX, CORZER, ERROR) FAP, SECONDARY ENTRY OF PROCOR 

FUNCTIONS IDENTICALLY TO SUBROUTINE FASCOR EXCEPT THAT IT DOES NOT 
MAKE THE TRANSIENT ASSUMPTION ABOUT Yd), I.E. IT GIVES EQUI -PRODUCTS 
CORRELATION. 



FASEP1 (Y, KMIN, KMAX, CORZER, ERROR) FAP, SECONDARY ENTRY OF PRCCCR 

FUNCTIONS IDENTICALLY TO SUBROUTINE FASEPC EXCEPT THAT THE CORRELAT ICN 
IS ADDED INTO THE OUTPUT AREA RATHER THAN BEING STORED INTO IT. 



*•**•*»*•»**»«»»»•*«»»»• 
* FASTRK TO FLOATV » 
»*••**•*»»*•»*••*»•«**»• 



PROGRAM DIGESTS 



•»•*•**•»••«••»••»«*»«•# 
* FASTRK TO FLOATV * 
#»•»*»***»•••*»•••#••#•• 



FASTRK (IXVECIXSTRT, IXLOOK, MXTRAK, I ANS ) FAP, 26 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
EXAMINES IXVEC( IXSTRT ) , IXVEC ( IXVEC < I XSTRT M ♦ IXVEC { I XVEC f IXVEC C IXSTRT )) * , 
...,ETC.,... UNTIL WHICHEVER OF THE FOLLOWING OCCURS FIRST, Al IT 
FINOS AN ELEMENT IXVEC(K) - IXLOOK, B) IT FINDS A ZERO ELEMENT IN 
IXVEC, OR C) MXTRAK EXAMINATIONS ARE COMPLETED WITHOUT ENCOUNTERING 
A) OR B)« SETS IANS « K,0, OR -1 FOR CASE A), B), OR C). 
REQUIRE IXVECCI) GRTHN* 0 AND I XSTRT, I XLOOK, MXTRAK GRTHN* 1, BUT 
THESE REQUIREMENTS NOT CHECKED. 

FOOT CLXY,X,Y,ANS) FAP, 4C REGISTERS 

OTHER ENTRY - FDOTR. NO TRANSFER VECTOR. 
SETS ANS = xm»Ym+XC2i*Y(2>+. # .+XCLXY)«Y(LXY) 9 WHERE LXY GRTHN* i . 

FDOTR (LXY,X,Y, ANS) FAP, SECONDARY ENTRY OF FDCT 

SETS ANS « X< l)*Y(LXY)+X{2)»Y<LXY-U+...+XtLXYI#Y(lt WHERE LXY 
GRTHN* 1 . 

FIRE2 (NRA,NCAT,NCAN, AA,NRR, NCR,RR,NRG,GG,FF, C ) FORTRAN, 271 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - IXCARG, STZ ,DOTP, MATML3 ,DOT J. 
SETS FFU...NRA*NCAN> - F( i. ..NRA, 1.. .NCANI WHERE SUM CFROM 
1=1 TO NRA) OF SUM (FROM J=l TO NCAN) OF 

{F<I,J)*R(I-K,J-L) ) = G(K,L) FOR K=1...NRA, L=1...NCAN, GIVEN 
FU...NRA,l...NCAN-l). RR ( 1 • . ♦ NRR*NCR I » RC-NRR/2. . .NRR/2 ,0.. .NCR-1 1 
WHERE NRR MUST BE ODD. GGU...NRG) * GC-NRG/2. . .NRG/2, NCANI . 
AA(1...NRA»NCAT«NRA) AND CC( 1. ..4»NRA«NRA) ARE THE OUTPUTS OF 
SUBROUTINE RLSPR2. NCAN MUST BE LSTHN« NCAT. 

FIXV (X,LX,IXFIXD) FAP, 35 REGISTERS 

OTHER ENTRY - FIXVR. NO TRANSFER VECTOR. 
SETS IXFIXDU...LX) FROM XU...LX), WHERE IXFIXOCI) = XFIXFfXU)), 
WHERE X(l) IS TRUNCATED BEFORE FIXING. EQUI V( IXF IXD,XI OK. STRAIGHT 
RETURN IF LX LSTHN= 0 . 

FIXVR CX 9 LX V IXFIXD) FAP, SECONDARY ENTRY OF FIXV 

IDENTICAL TO FIXV EXCEPT X( 1 1 IS ROUNDED BEFORE FIXING. 

FLDATA (LX,X,SCALE) FAP, SECONDARY ENTRY OF FXCATA 

SETS XQ...LX) « (FLTG.PT. FORM OF X ( 1 .. .LX )) /SCALE , WHERE X ON 
INPUT ARE CONSIDERED 35-B I T-PLUS-S IGN INTEGERS, AND SCALE IS A NCN-ZERC 
FLTG. NO. STRAIGHT RETURN IF LX LSTHN* 0 OR IF SCALE = 0. 

FLOATMF ( INTEGR ) FAP, 25 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
FUNCTION CONVERTS INTEGR TO FLTG.PT., WHERE INTEGR IS ANY 
35-B IT-PLUS-SIGN INTEGER. 

FLOATV { IX,LIX,XFLOTD) FAP, 22 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XFLOTDU...LIX) FROM IXU...LIX), WHERE XFLOTD(I) * 
FLOATF( I X ( I ) ) • EQUIV(XFLOTD,IX) OK. STRAIGHT RETURN IF LIX LSTHN= 0 . 



***»•»•**»*»**»*»*»•*«*» 

* FMTOUT TO FT24 * 
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«*»•*•*•»*»••«*••«»»•*•* 

* FMTOUT TO FT24 ♦ 
*•»*•«••***•• *».»•* •»•••• 



FMTOUT { ITAPE»FMT) FORTRAN, 51 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - FNOFMT, RPLFMT, i STH ) , (F IL I . 
OPERATION IS EQUIVALENT TO WRITE OUTPUT TAPE ITAPE ,FMT , WHERE FMT(I) 
IS A NORMLIT FORMAT VECTOR, AS OEFINED ABOVE IN CVSOUT. 



FNOFMT ( FMT, IXCFMT ) FAP, 88 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - REVER. 
ON INPUT FMT ( I ) IS A NORMLIT FORMAT VECTOR AS DEFINED IN CVSOUT ABOVE. 
IF FMT IS NORMAL, IXCFMT IS SET = TO INDEX WITH RESPECT TO COMMON OF 
FMT ( 1 ) t AND NO OTHER OUTPUT. IF FMT(I) IS LITERAL THEN IT IS REVERSED 
IN PLACE, WITH ENCLOSING PARENTHESES ADDED TO MAKE IT A LEGAL FORMAT AND 
IXCFMT IS SET * INDEX WITH RESPECT TO COMMON OF THE RESULTING FORMAT 
VECTOR. SUCCESSIVE CALLS OF FNDFMT WITH LITERAL FORMAT WORK PROPERLY 
WITHOUT LEADING TO RE-REVERSAL. 

FRAME FAP (709) , 4 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 

FAP (7090), 9 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
ADVANCES FILM IN SCOPE CAMERA BY ONE FRAME. SEPARATE VERSIONS 
FOR 709, 7090. 



FRQCTl (IX,NX,IXL0,IXHI,ICT,IANSI FORTRAN, 117 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS ICT(1...IXHI-IXL0+1) » IC ( IXLO. . . I XHI ) WHERE ICU) * NO. OF 
ELEMENTS OF IX(1...NX) WHICH HAVE VALUE * J. IXLO LSTHN 38 ALL IX C I ) 
LSTHN= IXHI. IANS^O IF OK, = 1 OR 2 IF ILLEGAL NX OR IXLO. 

FRQCT2 (X,LX,B,LB,ICOUNT,IANS) FAP, 117 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS IC0UNT(1...L8*1) WHERE ICOUNT(J) * NO. OF VALUES IN XU...LX) 
SUCH THAT B(J-l) LSTHN* X LSTHN B(J), GIVEN MONOTONELY INCREASING 
VECTOR BU...LB), WHERE BIO) AND BUB+l) ARE INFERRED TO BE - AND ♦ 
INFINITY. IANS = 0 IF OK, * 1,2, OR 3 IF ILLEGAL LX, ILLEGAL LB, 
OR SOMETHING WEIRD. X MAY BE ANY MODE. 



FSKIP (ITAPE, NFILES) FAP, 50 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - i I OS ) , ( RDS ) , (BSR ) , ( TCO ) , 
(TEF), (TRCI. 

SPACES FORWARD NFILES FILES ON TAPE (BACKWARDS IF NFILES NEGATIVE), 
LEAVING TAPE AT END-OF- FILE-MARK EDGE FURTHEST FROM LOAD POINT. 
IF NFILES^O TAPE NO! MOVED. IF TAPE IS PART WAY THRU A FILE IT 
COUNTS AS 1 FILE. 



FT24 (D,A,8) FAP, 777 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - FXDATA, FLDATA. 
SETS AU...13) « CT(0...12) AND BU...13) « ST(0...12) WHERE CT(J) = 
SUM(FROM I»0 TO 23) OF ( X ( I ) *COS ( I* J«P I / 12 ) ) , ST(J) * SAME SUM WHERE 
SIN(...) REPLACES COS(...), AND X(0...23) IS GIVEN IN D(1...24). D,A,B 
ARE FLOATING BUT COMPUTATIONS CARRIED OUT FXD PT TO ACCURACY OF 1 PART 
IN 10,000. 



FT24 ( DO, AA, BB) - II FORTRAN, 818 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
OPERATES IDENTICALLY TO FAP VERSION OF FT24 EXCEPT COMPUTATION IS 
CARRIED OUT FLOATING POINT (THE FIXING PROCESS IS OMITTED). 



***»•**«*•*»•*•*»•••«*»» 
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» FXDATA TO GNFLTl * 



» FXDATA TO GNFLTl « 



•»»**••****»•*•*»••»*•«» 



••*•*•***••*•»•••••**«•* 



FXDATA ( LX,X, MXDATA, SCALE ) 



FAP, 102 REGISTERS 



OTHER ENTRY - FLDATA. NO TRANSFER VECTOR. 
SETS XU...LX) = SCALED AND FIXED FORM OF XU...LX), THE XIII BEING 
CONVERTED WITH ROUNDING TO MACH INE-L ANGUAGE- INTEGERS WITH MAXIMUM 
MAGNITUDE = MXDATA (GIVEN AS FORTRAN INTEGER). ALSO SETS SCALE = 
FLOATF ( MXDATA! /XMAX WHERE XMAX - MAX MAGNITUDE OF ORIGINAL X(I), BUT 
SETS SCALE - -1. IF LX LSTHN 3 0 OR MXDATA LSTHN* O f SCALE * -2. IF XMAX 
IS ZERO. 

GENHOL (HOD FAP, 48 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - (IOH). 
USAGE IS - CALL GENHOL ( HOL ) - PRINT FMT, LIST - FMT FORMAT t ) . 

GENHOL SETS HOLU...N) * HOLLERITH EQUIVALENT { FORMATINA6 1 1 TO LINE ( S ) 
WHICH WOULD HAVE BEEN PRINTED BY THE PRINT STATEMENT (WHICH WILL BE 
BYPASSED ON RETURN). N WILL = (5 + TOTAL CHARACTER COUNTJ/6 . 

GETHOL ( JOB, HARG, HOL , NCRS, IXCOM, I COUNT ) FORTRAN, 169 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - XLOCREVERS. 
HARG(l,G,~i...-LHOL+2) IS LHOL REGISTERS OF INPUT LITERAL 
HOLLERITH WITH FENCE AT HARG (-LHOL+1 ) . INITIALLY 

FENCE = OCT 777777777777, BUT IF THIS SAME CALL STATEMENT HAS BEEN 
OPERATED BEFORE WITH JOB NOT-0 FENCE WILL READ OCT 777777777776. 
SUPPOSE JOB NOT*0. THEN, IF FENCE = ALL 7 f S, GETHOL REVERSES STORAGE CF 
HARGU...-LHQL+2), SETS HARG C-LHOL+ 1 ) * OCT 777777777776, SETS NCRS = 
6*LH0L, SETS IXCOM « INDEX WITH RESPECT TO COMMON OF HARG (-LHOL+2 I , 
AND INCREMENTS ICOUNT BY 1 . IF FENCE * OCT 777777777776, SAME OUTPUTS 
EXCEPT NO REVERSAL OF HARGt 1 . . .-LHOL+2 ) . SUPPOSE JOB=C. THEN IF 
FENCE = OCT 777777777777, GETHOL SETS HOL ( 1.* .LHOL ) = HARGC 1,0, • . • , 
-LHOL+2), SETS NCRS * 6*LH0L, SETS IXCOM - INDEX WITH RESPECT TO COMMON 
OF HOL ( 1 > , ICOUNT NOT MODIFIED. IF FENCE = OCT 777777777776, SAME 
OUTPUTS EXCEPT HOL ( 1 .. .LHOL ) * HARG (-LHOL* 2 , ...,0,1). IN ANY CASE 
ERROR RETURN WITH NCRS * -1 IF LHOL EXCEEDS 106. 

GETRD1 ( ITAPE,NX, IX, IANS) FORTRAN, 229 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - (TSH) , (RTN). 
SETS IXU...NX) * NEXT NX (EXCEEDS 0) DIGITS FROM RANDOM DIGITS 
BCD TAPE (EACH CARD FORMAT( 50 1 1 ) ) MOUNTED ON LOGICAL TAPE NC. I TAPE. 
SETS IANS =0 IF OK, * -1 OR *2 IF ILLEGAL ITAPE OR NX. NEVER 
REWINDS ITAPE. 

GETX (X, II, 12,..., IN) (FORTRAN FUNCTION) FAP, 31 REGISTERS 

OTHER ENTRY - IGETX. NO TRANSFER VECTOR. 
SETS Y « GETX(X,I1,I2,...,IN) WHICH IS EQUIVALENT TO THE LIST CF 
FORTRAN STATEMENTS JNM1 « INMKIN), J2 * I2(J3), Ji « IKJ2), 

Y = X(J1). EQUIVALENCE ANY IN OK. 

GNFLTl ( AMSPEC,LSPEC,FLTR,IANS) FORTRAN, 232 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - COS. 
SETS FLTR(1...2*LSPEC-1) * SYMMETRICAL (ABOUT FLTR(LSPEO) 
COEFFICIENTS WHOSE AMPLITUDE SPECTRUM MATCHES SPECTRUM AMSPEC ( 1. . .LSPEC ) 
GIVEN AT EQUALLY SPACED FREQUENCIES FROM 0 TO PI. FLTR FORMED FROM 
TUKEY-HAMMING ORTHONORMAL SET. SETS IANS = 0 IF OK, = -1 FOR ILLEGAL 
AMSPEC (ALL ZERO), » -2 FOR ILLEGAL LSPEC (OUTSIDE RANGE 3 TO 10011. 
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GNHOL2 (DATA, NDATA, FMT, HOL, NCRS, IXCOM, INDEX) FAP, 74 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - (IOHI,(FIL>. 
FMT(l,0,...,-M+2) IS M REGISTERS OF INPUT LITERAL HOLLERITH 
REPRESENTING A FORMAT BY WHICH DATA! 1. . . NDATA) IS TO BE INTERPRETED 
(NDATA MAY * 0) . GNH0L2 SETS HOL ( 1. • • NCRS/6) = NCRS HOLLERITH 
CHARACTERS RESULTING FROM FMT AND DATA, SETS NCRS » 6*N0. WORDS 
IN HOL, SETS IXCOM « INDEX WITH RESPECT TO COMMON OF HOL ( 1 ) , AND 
INCREMENTS INDEX BY I . 

GRAPH (ISOL,IDOT,N, TITLE, YUNITS,XUNI TS, YTOP , FORTRAN, 1499 REGISTERS 

YBOT,XMAX,XMIN,NOPPP, IPAGE, SPACE) 

NO OTHER ENTRIES. TRANSFER VECTOR - DI SPLA , ( SPH ) , ( FIL ) ,L INE , LOG , 
EXP ( 2, XF IXM, FLOATM, DSPFMT, FRAME , XLOCMVBLOK , SCPSCL ,HSTPLT. 
PLOTS THE ELEMENTS OF AN ARBITRARY NO. OF FLTG. PT. VECTORS CALL OF 
SAME LENGTH N) EQUALLY SPACED ACROSS AN ARBITRARY NO. OF FRAMES 
(CONTROLLED BY NOPPP * NO. POINTS/PAGE, LAST POINT OF ONE FRAME BEING 
REPEATED AS FIRST POINT OF NEXT, 3 LSTHN * HCPPP LSTHN » 401). 
ISOLU...NS) = VECTOR OF MACHINE LOCATIONS OF VECTORS TO BE PLOTTED 
IN SOLID MODE WITH ISOL(NSd) » 0, SIMILARLY I DOT ( I . . . NDU ) SPECIFIES 
VECTORS FOR DOTTED MODE (NS+ND MUST EXCEED ZERO). SUCCESSIVE FRAMES 
SERIALIZED FROM IPAGE WHICH IS LEFT 1 GREATER THAN LAST INDEX USED. 
SPACE(1...N) USED FOR SCRATCH. YTOP AND YBOT DEFINE TOP AND BOTTOM OF 
PLOTTING AREA (SAME UNITS AS VECTORS, YTOP GRTHN YBOT). XMAX AND 
XMIN ARE ARBITRARY COORDINATES ASSOCIATED WITH NTH AND FIRST VECTOR 
ELEMENTS (XMAX GRTHN XMIN). PLOTS ARE SUPPLIED WITH LABELLED AXES AND 
CONVENIENT CHECK MARKS IN USER UNITS. TITLEU...8I = 48 HOLLERITH 
FOR PAGE HEADING. YUN I TS( 1. . .6 ) AND XUN ITS ( 1. . . 6 ) * 36 HOLLERITH EACH 
FOR LABELLING VERTICAL AND HORIZONTAL AXES. ALTERNATIVELY THE 48 
HOLLERITH FOR HEADING CAN BE SET IN TITLE! 1,0,-1 ,-7) WITH 
TITLE(l) = 6H$$$$$$ AS FLAG, USING HOLLERITH FIELD IN CALLING 
SEQUENCE. SIMILARLY FOR YUNITS, XUNITS. SPACE(l) IS SET = 0.0 IF OK, 
» 1.0 IF ILLEGAL N, NOPPP, YTOP, XMAX, OR NO. OF VECTORS (ALSO 
COMMENT MADE ON SCOPE). PLOTTING STYLE CONTROLLED BY SUBROUTINE HSTPLT 
OF WHICH THERE ARE SEVERAL ALTERNATIVE VERSIONS. GRAPH DOES NOT CHNAGE 
FRAMES BEFORE PLOTTING ITS FIRST PAGE OR AFTER ITS LAST PAGE. 

GRAPHX (ISOL,IDOT,N, TITLE, YUNITS, XUNITS, YTOP, YBOT, FORTRAN, 123 REGISTERS 

XMAX, XMIN, NOPPP, I PAGE, SPACE, NFRMZV) 

NO OTHER ENTRIES. TRANSFER VECTOR - GRAPH, FRAME. 
FUNCTIONALLY EQUIVALENT TO CALL GRAPH ( I SOL, . . . , SPACE ) EXCEPT THAT 
PLOTS ARE EXPANDED OVER NFRMZV (EXCEEDS ZERO) FRAMES IN VERTICAL 
DIRECTION, YTOP NOW REFERING TO UPPER EDGE OF TOP ROW OF FRAMES, YBOT 
TO LOWER EDGE OF BOTTOM ROW OF FRAMES, AND THAT SPACE(2) SET * 2.0 
IF NFRMZV ILLEGAL. 

GRUP2 ( P,NDELX,DELX, XLO, YLIM,NWANT, I ANS) FORTRAN, 201 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
GIVEN PU...NDELX) = HISTOGRAM TYPE PROBABILITY SUCH THAT 
P(I) = PROBABILITY OENSITY FOR VARIATE X IN RANGE XLO*( 1-1 ) *DELX 
TO XLO*I»DELX, (WITH SUM (FROM 1=1 TO NDELXI OF (P(II»DELX) REQUIRED 
TO = 1.0), THEN GRUP2 SETS XLIMd.. .NWANT + 1 ) SUCH THAT INTEGRAL OF 
P(X) FROM XLIMd) TO XLIMU + l) EQUALS 1/NWANT, WITH XLIMd) = XLO 
AND XLIM(NWANTd) = XLO ♦DEL X*N WANT, AND SETS IANS » 0 IF OK, 
« -It -2, -3, OR -4 IF ILLEGAL NDELX (LSTHN 2), DELX (LSTHN* 0.), 
NWANT (LSTHN 2) OR SOMETHING WEIRD. 
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HALVL (X,LX) FAP, SECONDARY ENTRY OF DUBLX 

SETS XU...LX) » 1/2 OF INPUT XU...LXI. MAGNITUDE OF LX IS USED AND 
LX'O TREATED AS LX=1 . 

HALVX (IX,LX) FAP, SECONDARY ENTRY OF DUBLX 

SETS IXU...LX) « 1'2 OF INPUT IXU...LX). MAGNITUDE OF LX IS USEO AND 
LX=0 TREATED AS LX=i . 

HLADJ F(HQL) FAP, 46 REGISTERS 

OTHER ENTRY - HRADJ. NO TRANSFER VECTOR. 
USAGE, HOLAD J-HLADJF (HOL I , SETS HOLADJ ■ LEFT ADJUSTED FORM OF HCL 
TREATED AS 6 8CD CHARACTERS (SPACES ROTATED TO RIGHT END). 

HRADJ F(HOL) FAP, SECONDARY ENTRY OF HLADJ 

USAGE, HOLADJ*HRADJF(HOL), SETS HOLADJ =* RIGHT ADJUSTED FORM OF HOL 
TREATED AS 6 BCD CHARACTERS (SPACES ROTATED TO LEFT END). 

HSTPLT (LNY,NY,ORG,NDELX,DOT,AXIS, IFRSTB, ISKIPBI FAP, 145 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - L INEH, L INEV. 
PLOTS NYU...LNY) GIVEN IN SCOPE UNITS (0 TO 1023), EACH POINT 
PLOTTED AS HORIZONTAL BAR OF SCOPE LENGTH NDELX/128 EXCEPT BARS FOR 
END POINTS HALF AS LONG, WHERE LEFT X COORDINATE OF FIRST BAR 
GIVEN (FLTG.PT. SCOPE UNITS) IN ORG(l), AND WITH ENDS OF SUCCESSIVE 
BARS CONNECTED BY VERTICAL BARS, ALL BARS BEING SOLID OR DOTTED 
AS DOT * 0. OR NOT * 0. ALSO OPTIONALLY (YES IF AXES * 0. , NO IF NOT) 
PLOTS SOLID HORIZONTAL AXIS FROM ( X , Y ) = ( ORG ( 1 I ,ORG ( 2 M TO (X,Y) = 
(ORG(3),ORG(2M WITH VERTICAL CHECK MARKS AT MIDDLES OF BARS FOR 
NY ( I FRSTB ) , NY( I FRSTB+ I SKIPB ) , NY ( IFRSTB+2» I SK IPB ) , . . . WHERE 
IFRSTB, ISKIPB GRTHN* 1 . 

HSTPLT (LNY,NY,ORG,NDELX,DOT, AXIS, IFRSTB, ISKIPB) - II FAP, 188 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - L INEH,L INEV. 
FUNCTIONS SIMILARLY TO HSTPLT BUT PLOTS NYU...LNY) AS VERTICAL 
LINES FROM Y ORIGIN » NY(1) (REMEMBERED FROM FIRST CALL GF 
HSTPLT-II WITH AXIS * 0). 0RGU...3), NDELX, DOT, AXIS HAVE 
SAME MEANING AS HSTPLT, BUT IFRSTB, ISKIPB IGNORED. 

HSTPLT (LNY, NY, ORG, NDELX, DOT, AXIS, IFRSTB, ISKIPB) - III FAPU09I, 256 REGISTERS 
NO OTHER ENTRIES. TRANSFER VECTOR - LINEH. 

FAP(7090), 258 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - LINEH. 
FUNCTIONS SIMILARLY TO HSTPLT BUT PLOTS NYU...LNY) AS DARK POINTS 
WITH LIGHTER CUBIC CURVES INTERPOLATED BETWEEN POINTS. 

HVTOIV (HV,LHV,IV) FAP, 39 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS IV(1...6*LHV) AS SPREAD OUT FORM OF HVU...LHV) ASSUMED TO 
BE IN FORMAT (LHVA6), SO THAT EACH IV(I) IS INTEGER IN RANGE 0 TO 63. 
FUNCTION IS EXACT INVERSE OF SUBROUTINE IVTOHV. 

IDERIV ( Y0FX1 ,DYDX,DELX,LY,YOFX ) FAP, 54 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS YOFX(i) * Y0FX1, Y0FX(2) * DELX»0YDX(1) ♦ YOFX(i), 
AND (IF LY GRTHN 2) YOFX(K) * 2»D£LX»DYDX ( K- 1 ) + Y0FX(K-2) 
FOR K * 3,4, ...,LY. EQUI V( Y0FX,0YDX ) OK. STRAIGHT RETURN 
IF LY LSTHN 2 OR DELX*G. IS EXACT INVERSE OPERATION TO THAT OF 
SUBROUTINE DERIVA. 
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IF (X,NXNEG,NX£ER,NXPOS) FAP» PSEUDO ENTRY OF SEVRAL 

USAGE IS CALL SEVRAL ( . . . , 2HIF, X,NXNEG,NXZER ,NXPOS, . . . ) . 
FUNCTION IS SIMILAR TO FORTRAN STATEMENT IF(X) NXNEG ,NXZER,NXPOS 
WHERE NX IS THE INDEX OF A SUBROUTINE RELATIVE TO THE IF SEQUENCE 
(NX NEGATIVE FOR PRIOR SUBROUTINES). LOOPS WITHIN LOOPS MAY BE BUILT 
WITH PSEUDO IFS. 

IFNCTN (YOFX, LYOFX, XFIRST, XL A ST, LXOFY, FAP, 208 REGISTERS 

YLOt YHI f IERRLOt XOFYt IANS) 

NO OTHER ENTRIES. TRANSFER VECTOR - MONOCK » REVER. 
SETS XOFYU... LXOFY) SUCH THAT Y( XOFY ( i ) )»YLO, Y(X0FY(2) )-YLO*DELY, 
Y(X0FY(3) l«YL0+2»DELY, Y ( XOFY (L XOFY 1 1* YHI , WHERE DELY * 

(YHI-YL0)/LX0FY-1) AND WHERE THE FUNCTION Y(X) IS DEFINED BY STRAIGHT 
LINE SEGMENTS BETWEEN THE VALUES Y( XFIRST) =YOFX( 1 ) , Y ( XFIRST+DELX ) - 
YGFX(2), Y(XFIRST*2*DELX)*Y0FX(3), Y( XLAST) =YOFX UYOFX ) WITH 

DELX = (XLAST-XFIR$TI/(LY0FX-1), WHERE YOFXI I. . .LYOFX) MUST BE EITHER 
MONOTONE NON-INCREASING OR MONOTONE NON-DECREASING. IF THE INVERSE 
FUNCTION X(Y) HAS A VERTICAL RISE OR DROP AT A REQUIRED Y VALUE THE 
MIDPOINT IS SELECTED FOR XOFY. REQUIRE LYOFX GRTHN 38 2, LXOFY 
GRTHN* 1, XFIRST NOT* XLAST, AND, IF YMAX * MAX! YOFX( 1.. .LYOFX )) , 
YMIN = MIN(Y0FX(1...LY0FX)), YMIN LSTHN* YLO LSTHN YMAX IF LXCFY 
GRTHN* 2 BUT YMIN LSTHN* YLO LSTHN 33 YMAX IF LXOFY * 1, AND 
YLO LSTHN YHI LSTHN* YMAX IF LXOFY GRTHN* 2 . SETS IANS * 0 
IF OK, * IERRLO+K, K*0, 1,3,4,5, OR 6 IF YOFX, LYOFX, XLAST, LXOFY, YLO, 
OR YHI ILLEGAL. 

IGETX (IX, II, 12,..., IN) (FORTRAN FUNCTION) FAP, SECONDARY ENTRY OF GETX 

PERFORMS SAME FUNCTION AS GETX. 

IINTGR (YOFXI, YIGRTD, DELX, LY, YOFX, CIGRTN) FAP, 49 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS YOFX(l) * YOFXi, AND (IF LY GRTHN 1) YOFX (Kt * (2/DELXM 
(YIGRTD(K) - YIGRTD(K-l)) - YOFX(K-i) FOR K*2...LY. 

EQUIVUOFX, YIGRTD) OK. STRAIGHT RETURN IF LY LSTHN 1 OR DELX=0. (BUT 
DELX MAY BE NEGATIVE). FUNCTION IS EXACT INVERSE TO THAT OF SUBROUTINE 
INTGRA. 

INDATA ( ITAPE, IRECNO, NOPTS, DATA, ERR, 6HNAUXLI, FORTRAN, 896 REGISTERS 

AUXH , . . . , 6HNAUXLN, AUXLN) 

NO OTHER ENTRIES. TRANSFER VECTOR - VARARG, FSK IP, ( TSBI , (RLR) , 
FAPSUM,LOC,MVBLOK, XSAME , (SPH),(FIL) ,(STH) ,UNPAKN. 
SEARCHES LOGICAL TAPE ITAPE (ASSUMED TO HAVE BEEN CREATED BY 
SUBROUTINE OUDATA) FOR RECORD NO. IRECNO (IRECNO ANY MODE), EXCEPT 
THAT IF IRECNO = 0 IT MERELY GOES AFTER NEXT RECORD ON TAPE AND THEN 
SETS IRECNO * RECORD NO. FOUND. IF THE RECORD IS FOUND (ALWAYS IF 
IRECNO = 0) AND IF ON INPUT NOPTS IS GRTHN * 0, INDATA SETS 
DATA(1. • .LREC) * RETRIEVED DATA (AS ORIGINALLY FED TO OUDATA), 
SETS NOPTS * LREC WHERE LREC HAS BEEN OBTAINED FROM THE TAPE, AND THEN 
PROCEEDS TO PROCESS ARGUMENTS BEYOND ERR (IF ANY). IF HOWEVER NOPTS 
WERE LSTHN 0 ON INPUT THE SETTING OF DATA( 1 . . . LREC ) IS OMITTED. 
(NOTE THAT DATA SHOULD BE DIMENSIONED TO LARGEST OF LRECU OR 
ABOUT 200.) IF RECORD NO. NOT FOUND CONTROL RETURNS TO CALLING PROGRAM. 
THE N PAIRS OF ARGUMENTS BEYOND ERR ARE OPTIONAL. (BUT N MUST NOT 
EXCEED 25). FIRST OF EACH PAIR IS 6 HOLLERITH (1A6) NAMING DESIRED 
AUXILIARY INFORMATION AS ORIGINALLY FED TO OUDATA FOR THIS RECORD, 
AND THE SECOND IS STORAGE LOCATION FOR THE RETRI EVED INFO (MUST BE 

(CONTINUED NEXT PAGE) 
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DIMENSIONED AS ORIGINALLY FED TO OUDATA) , BUT THE ORDERING AND 

TOTAL NO* OF AUXILIARY REQUESTS NEEDN'T MATCH THOSE OF THE ORIGINAL 

OUDATA CALL. INOATA SETS AUXL1 ( 1 ...),..., AUXLN( 1 ... ) ACCORDINGLY, 

EXCEPT OMISSIONS WILL OCCUR IF NAME CAN* T BE FOUND ON TAPE. SETS ERR = 

0. IF ALL OK i = 1. IF I OR MORE AULX REQUESTS NOT FILL ABLE , *2. 

IF SUMCK ERROR ON TAPE (DOESN'T STOP FILLING REQUESTS ) * 3. 

IF TOO MANY DIFFERENT VALUES OF ITAPE HAVE OCCURRED (LIMIT PRESENTLY 

■ 2), * 4. IF IRECNO NOT FOUND* * 5. IF ILLEGAL NO. ARGUMENTS IN CALL 

STATEMENT (MUST BE ODD), * 6. IF THERE ARE AN EXCESSIVE NO* OF 

RECORDS ON THE TAPE (PRESENT LIMIT * 200). ALSO ON-LINE ERROR 

PRINT OCCURS. 



INDEX F( I, ICRTCL) FAP, 50 REGISTERS 

OTHER ENTRIES - V INDEX, SETEST, SETAPT.CHUSET* NO TRANSFER VECTOR. 
ADDS 1 TO MACHINE LOCATION CONTAINING I THEN SETS ACCUMULATOR = 
-1.0 IF NEW I LSTHN ICRTCL, * 0.0 IF NEW I * ICRTCL, * +1.0 
IF NEW I GRTHN ICRTCLt WHERE +0 AND -0 TREATED AS EQUAL. NOT 
RELATED TO XINDEX FUNCTION. 



INTGRA ( C IGRTN, YOFX,LY,DELX, YIGRTD, Y0FX1 ) FAP, 47 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS YIGRTD(l) * C IGRTN , AND (IF LY GRTHN II 
YIGRTD(K) * YIGRTD(K-l) ♦ DELX* ( YOFX (K ) + YOFX(K-l) )/2.0 
FOR K * 2...LY, AND YOFXl * YOFX(l). EQUIV( YIGRTD, YOFX ) OK. 
STRAIGHT RETURN IF LY LSTHN 1 OR DELX * 0. (MAY BE NEGATIVE). 
FUNCTION IS EXACT INVERSE TO THAT OF IINTGR. 

INTHOL ( NHOL ,HOL,FMT,NDATAD, ND AT A A, DATA ) FAP, 72 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - FNDFMT, ( IOHI , ( RTNI . 
INTERPRETS A VECTOR OF HOLLERITH WORDS HOL ( 1. . . NHOL ) (NHOL GRTHN* 1) 
ACCORDING TO A FORMAT FMTU... ) TO ATTEMPT TO FIND NDATAC (GRTHN* 
I) DATA VALUES. THE DATA VALUES FOUND WHILE MAKING ONE SCAN OF HOL 
AND FMT ARE STORED IN DATA ( 1 . . .NDATAA I . 

INTMSB FAP, SECONDARY ENTRY OF TIMSUB 

SEE ABSTRACT OF TIMSUB BELOW. 

INTOPR ( NDATA, XLO, DELX, X tOPER ) FAP, 111 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS OPERd... NDATA) SUCH THAT, FOR ANY DATA VALUES D ( 1 .. .NDATA ) , 
THE SUM (FROM I * 1 TO NDATA) OF OPER(I)*D(I) WILL EQUAL P(X), 
WHERE P IS THE EXACT FITTING POLYNOMIAL OF DEGREE NDATA- 1 SATISFYING 
P(XL0+(I-1)»DELX) =D(I) FOR 1*1. ..NDATA. REQUIRE NDATA * lt2»3, OR 4 
AND DELX NOT* 0.0 . STRAIGHT RETURN WITH NO OUTPUT FOR ILLEGAL 
NDATA OR DELX. 



INTSUM (X,LX,XISUMD) FAP, 27 REGISTERS 

OTHER ENTRY - XNTSUM. NO TRANSFER VECTOR. 
SETS XISUMD(I) * SUM (FROM J * 1 TO I ) OF X(I), 1*1. ..LX. 

EQUIV(XISUMD,XI OK. STRAIGHT RETURN IF LX LSTHN 1. 

IPLYEV (LA,A,X,Y,EVR,EVI ) FORTRAN, 98 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - (IFMP). 

IF Z*X+I*Y (I*SQRT(-1)I, IPLYEV SETS EVR AND EVI WHERE 

EV * EVR+I*£VI = SUM (FROM K * 1 TO LA) OF (A(K)»Z(TO THE K- 1 ) ) . 
LA MUST BE GRTHN* 2 . 
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ITOMLI (IV,LIV,MLIV,IANS) FAP, 37 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS MLIVU...LIV) « IVU...LIV) SHIFTED RIGHT 18 PLACES 
ARITHMETICALLY. EQUIVI IV, ML IVI OK. SETS IANS * 0 IF OK, = -1 IF 
LIV LSTHN 1 . 



IVTOHV (IV,LHV,HV) FAP, 70 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS HVU...LHV), 8Y PACKING IV ( 1. . *6*LHV ) 6 AT A TIME USING 
ONLY BITS 12-17 OF IVCI). I V ( 1, 2, • • • , 6 ) GOES TO HV(l) (BITS 
S 1-5, 6-11, 30-35), ETC. STRAIGHT RETURN IF LHV LSTHN 1 . TURNS 

OFF AC OVERFLOW INDICATOR. FUNCTION IS EXACT INVERSE TO SUBROUTINE 
HVTOIV. EQUIV (IV,HV) OK. 

IXCARG (ARG,IXCOM) FORTRAN, 35 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - XLOC. 
SETS IXCOM * INDEX WITH RESPECT TO COMMON OF ARG. 



KIINT1 (CHISQ, NDF, PROB, IANS) FORTRAN, 191 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - SQRT,EXPC 3,N0INT1. 
SETS PROB = PROBABILITY THAT CHI-SQUARE WILL EXCEED CHISQ FOR 
NDF DEGREES OF FREEDOM. SETS IANS = 0 IF OK, = 1 IF CHISQ 
LSTHN 0. , = 2 IF NDF LSTHN 1 . 

KOLAPS (XMID,M, TYPE, L,CMID, ERR) FAP, 100 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS CMID(-LU,...,L*1) = C(-L,...,*L) WHERE C(I) * XCI) ♦ 
X(I*2»L) ♦ X(I-2*L) + X(I*4«L) ♦ X(I-4*LI ♦ ... FOR I « -(L-ll ... 
L-l AND C(-L), C(L) * ONE HALF OF ABOVE EXPRESSION, WHERE THE 
X SERIES X(-M...+M) IS GIVEN IN XMID(-M+1. . .M+l) . TYPE « 0.0 
SIGNIFIES X IS FXD.PT., NOT = 0. SIGNIFIES FLTG.PT. SETS 
ERR * 0. IF OK, » 1.0 IF L LSTHN 1 OR M LSTHN 0, » 2. IF OVERFLOW 
OCCURS. (L MAY EXCEED M) EQUIV(CMID,XMIDI OK. 

LIMITS (IANSX1,IANS, X1,X1A,X18, X2,X2A,X2B, FAP, 44 REGISTERS 

XN,XNA,XNB) 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS IANS«0 IF XJLO LSTHN* XJ LSTHN* XJHI FOR J«1...N WHERE J 
IS TRIPLET INDEX AND X JLO=MIN( XJA, X J8 ) X JH I=MAX ( XJA , X JB ) , BUT SETS 
IANS = IANSXH-K-1 IF XK FAILS TO LIE IN CLOSED RANGE XKLO TO XKHI 
WHERE K IS THE LOWEST SUCH INDEX. MODES OF ARGUMENTS IMMATERIAL. 
PLUS AND MINUS ZERO ARE TREATED EQUAL IN THE COMPARISONS. N SHOULD 
EXCEED ZERO AND ARGUMENT COUNT BE 2*3*N (OTHERWISE ILLEGAL RETURN). 



LINE (X1,Y1,X2,Y2) FAP (709) , 91 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 

FAP (7090), 95 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
PLOTS STRAIGHT LINE ON SCOPE FROM (XI, YD TO (X2,Y2) WHERE 
X1,Y1,X2,Y2 ARE IN FLTG.PT. SCOPE UNITS (0. TO 1023.). SEPARATION 
BETWEEN INDIV. PTS. ON LINE WILL LIE BETWEEN 1.414 AND 2.0 SCOPE UNITS. 
PLOTTING OMITTED IF X1,Y1,X2, OR Y2 ILLEGAL. 
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LINEH (NXLEFT,NYLEFT»NXRITE , NDELX ) FAP (709) , 34 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 

FAP (7090), 35 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
PLOTS STRAIGHT HORIZONTAL LINE ON SCOPE FROM ( NXLEFT ,NYLEFT I TO 
(NXR ITE ,NYLEFT I WHERE ALL ARGUMENTS IN FXD.PT. SCOPE UNITS (SHOULD BE 
0 TO 1023, ARE TREATED MODULO 1024), AND WHERE SEPARATION BETWEEN 
INDIVIDUAL POINTS WILL BE NDELX UNITS. NXRITE SHOULD EXCEED NXLEFT AND 
DELX EXCEED 0. 

LINEV (NXBOT, NYBOT, NYTOP, NDELY) FAP (709) , 34 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 

FAP (7090), 35 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
PLOTS STRAIGHT VERTICAL LINE ON SCOPE FROM ( NXBOT ,NYBOT ) TO (NXBOT, 
NYTOP) WITH NDELY UNITS BETWEEN INDIVIDUAL POINTS, WHERE ALL 
ARGUMENTS ARE IN FXD.PT. SCOPE UNITS (SHOULD BE 0 TO 1023, ARE TREATED 
MODULO 1024). NYTOP SHOULD EXCEED NYBOT AND NDELY EXCEED 0 . 

LINTR1 (X, XLO, DELX, TABLE, NT ABLE, YOFX) FORTRAN, 96 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
GIVEN TABLE ( 1. • .NT ABLE ) CORRESPONDING TO ARGUMENT VALUES XLO , XLG+DELX , 
...,XL0+(NTABLE-1)*DELX, LINTRl SETS YOFX « LINEARLY INTERPOLATED 
VALUE FROM THE TABLE CORRESPONDING TO ARGUMENT VALUE » X . 
X MUST LIE IN RANGE OF TABLE ARGUMENTS, DELX MUST EXCEED 0., AND 
NTABLE EXCEED 1 . 

LISTNG ( I T APE, JT APE, DAT A ) FORTRAN, 755 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - < RWT ) , C STH ) , { F IL ) , ( TSB ) » (RLR ) , 
FAPSUM , SAME , XS AME , ( SPH ) , FSK IP , SHFTR2. 
MAKES A LISTING ON OUTPUT TAPE JTAPE OF THE RECORD NOS. AND 
AUXILIARY INFO FROM THE INDATA-OUDATA TYPE TAPE ON LOGICAL I TAPE 
AND CHECKS SUMCHECKS. ITAPE IS LEFT REWOUND BUT JTAPE IS NEVER 
MOVED BACKWARDS. DATA( 1. . .MAX ) IS USED FOR SCRATCH WHERE MAX = 1+LENGTH 
OF LONGEST RECORD ON ITAPE. 

LOC ( VAR, I ADD) FAP, 4 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS I ADD = MACHINE ADDRESS OF VAR. 

LOCATE (SUBRU1,SUBRU2,...,SUBRUN) FAP, 512 REGISTERS 

OTHER ENTRIES - WHERE, CALL, CALL2, SETSBV, SETUP, RETURN, XINDEX ,ARG, 
XARG, STORE, XNARGS , XNAME. NO TRANSFER VECTOR. 
USAGE IS CALL LOCATE ( SUBRU1 , SU8RU2 SUBRUN ) 
CALL SUBR1 ( ARG1 1 , ARG12, ••• ,ARG1M1) 
ETC. 

CALL SUBRN ( ARGN1 , ARGN2 , . . • , ARGNMN ) 
THEN LOCATE ESTABLISHES A 1-1 EQUIVALENCE BETWEEN THE REAL 
SUBROUTINE NAMES SUBR1 SUBRN AND THE PROXY NAMES 

SUBRU1,...,SUBRUN FOR USE IN LATER CALL CALL, CALL CALL2, OR CALL WHERE 
STATEMENTS. CONTROL RETURNS BEYOND CALL SUBRN STATEMENT. THE ARGUMENT 
LISTS (ARG11 ETC.) ARE OPTIONAL (SUBROUTINE WHERE MAY USE THEM LATER). 
MAX NO. OF CALL LOCATE STATEMENTS IS 14. 



****»•*»*•**»**•*»»••**» 
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••*•*•»*•*•••*»•*•*••••« 



♦ LSHFT TO MATRA » 



♦ LSHFT TO MATRA » 



»»»•*••**•*•***»#*»•***• 



LSHFT F(N,X) 



FAP, 



12 REGISTERS 



OTHER ENTRY - XLSHFT. NO TRANSFER VECTOR. 
LOGICALLY SHIFTS X N BINARY PLACES (SHIFT IS LEFT IF N NEGATIVEl • 



NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS CO AND CI SUCH THAT ( Y(XMIN)-CC-Cl«XMIN) »*2+. . 
(Y(XMAX)-C0-C1*XMAX)»*2 IS MINIMUM, GIVEN YY( 1)*Y( XMINI , 
YY(2)=Y(XMIN*DX) , . .. ,YY(LY)*Y(XMAX) , WHERE DX=(XMAX~XMIN)/(LY-1) . 
LY MUST EXCEED 1 . 

LSSSl (L,A,R,G,F, ALPHA) FORTRAN, 122 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - FOOT. 
SOLVES THE EQUATION SUM (FROM 1*1 TO LI OF FCL-I*1I*R( I-K+ll * 
G(L-K+2I GIVEN THE SOLUTION OF SUM (FROM 1*1 TO LI OF 
F(L-I+1)»R{ I-K+i) * G(L-K+l) WHERE RU...L) IS ONE SIDE OF AN 
AUTOCORRELATION VECTOR (R(l) IS THE CENTER TERM), A(i...L) IS THE 
LEAST SQUARE PREDICTION ERROR OPERATOR FOR R, GU...L + 1I IS A SECTICN 
OF A CROSSCORRELATION VECTOR, AND ALPHA IS THE EXPECTED ERROR 
CORRESPONDING TO A. L MUST BE GRTHN* 2 . 

MATINV (NRA, A, AINV,SPACE, ERR) FORTRAN, 90 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - SIMEQ 
SETS AINV(1...NRA«NRA) * MATRIX INVERSE OF A ( 1. • .NRA«NRA ) • 
EQUIVALENCE (A,AINV) OK. ERR * 0. IF ALL OK, * 1. IF OVERFLOW 
OCCURS, * 2. IF A IS SINGULAR. SPACE ( i. (NRA+1 )»NRAI IS SCRATCH. 
NRA MUST BE GRTHN 0, BUT IS NOT CHECKED. 

MATML1 (NRABC,AA,BB,CC,ZIFSTO) FAP, 61 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS CC = CM WHERE CM * MATRIX PRODUCT OF AA AND BB IF 
ZIFSTO * 0. SETS CC * CC+CM IF ZIFSTO NOT* 0. AA( 1. . .NRABC*NRABC ) , 
BB( 1 • • .NRABC*NRABC ) , AND CC( I. . .NRABC»NRABC) ARE NRABC BY NRABC 
MATRICES ALL STORED BY EITHER ROWS OR COLUMNS. EQUIVALENCE (AA,BB) 
OK. NRABC MUST BE GRTHN* 1 BUT THIS IS NOT CHECKED. 

MATML3 (NRAC,NCARB,NCBC,AA,BB,ZIFNTR,CC, ZIFSTO) FORTRAN, 120 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - DOTJ. 
SETS CC * CM WHERE CM * MATRIX PRODUCT OF AA AND BB IF 
ZIFSTO = 0. SETS CC * CC+CM IF ZIFSTO NOT* 0. AA ( 1. . .NRAC»NCARB ) 
IS AN NRAC BY NCARB MATRIX STORED BY COLUMNS. BB( 1. • .NCARB»NCBC ) 
IS AN NCARB BY NCBC MATRIX STORED BY COLUMNS, IF ZIFNTR * C, OR 
BY ROWS, IF ZIFNTR NOT* 0. CC ( 1. . .NRAC*NCBC I IS AN NRAC BY NCBC 
MATRIX STORED BY COLUMNS. ROUTINE RETURNS (CC MAY BE SET TO ZERO) IF 
NRAC, NCARB, NC8C ARE LSTHN* I . EQUIVALENCE (AA,BB) OK. 

MATRA ( A,N,M, ATRANI FAP, 92 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS ATRAN( 1. • «N*M) = TIGHT PACKED TRANSPOSE OF THE TIGHT PACKED MATRIX 
A(1...M»N) WHERE A (STORED BY COLUMNS) HAS N ROWS AND M COLUMNS. BIT 35 
IS SET * 0 THROUGHOUT ATRAN. EQUI V( ATRAN, A ) IS OK. N AND M MUST BE 
GRTHN* 1 . 



LSLINE (YY,LY,XMIN,XMAX,C0,C1) 



FORTRAN, 117 REGISTERS 



»*•••»»*****•»••»•»#•••* 
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PROGRAM DIGESTS 



••#»*»*»•••••***»*»**•»# 
# MATRAl TO MDOT3 * 
••**»••***•••«•#**»••••* 



MATRAl ( NRCA, AA) FAP f 42 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
STORES THE TRANSPOSE OF THE SQUARE MATRIX AA C 1. ♦ .NRCA*NRCA I ONTO 
ITSELF. NRCA MUST BE GRTHN* I (NOT CHECKEOI. 



MAXAB (LX,X,XMAX2tII FAP, SECONOARY ENTRY OF MAXSN 

SETS XMAX2 AND I, GIVEN X(1...LX), SUCH THAT XMAX2*XU) 
WHERE MAGNITUDE OF XCII IS GREATEST MAGNITUDE OF XU...LXI. 
(NOTE XMAX2 MAY BE NEGATIVE. ) LX MUST EXCEED 0 . X MAY BE ANY MODE. 



MAXABM (FOFIJt LltLJt IDINENt FAP, SECONDARY ENTRY OF MAXSNM 

FMAXABt IMAXABt JMAXAB ) 
SETS FMAXAB, IMAXABt JMAXAB SUCH THAT FMAXAB * FOFIJ ( IMAXAB, JMAXAB ) 
SATISFIES MAGNITUDE (FMAXAB ) GRTHN* FOFIJ(l,J) FOR 1=1. ..LI, 
J*i...LJ WHERE USER HAS DIMENSION FOFIJ ( IDIMEN, IGNORDI. FOFIJ MAY 
BE FIXED OR FLOATING. LI AND LJ MUST EXCEED ZERO, AND IDIMEN 
GRTHN* LI (NOT CHECKED I. 



MAXSN (LX,X,XMAXi, I) FAP, 54 REGISTERS 

OTHER ENTRIES - MI NSN, MAXAB, MINAB. NO TRANSFER VECTOR. 
SETS XMAX1 AND I, GIVEN XQ...LX), SUCH THAT XMAX1=X ( 1 1 IS 
GRTHN* ALL OTHER XU...LX). LX MUST EXCEED C . X MAY BE ANY MODE. 



MAXSNM (FOFIJ, LI, LJ, IDIMEN, FMAXSN, IMAXSN, JMAXSNt FAP, 61 REGISTERS 

OTHER ENTRIES - MINSNM, MAXABM, MINABM. NO TRANSFER VECTOR. 
SETS FMAXSN, IMAXSN, JMAXSN SUCH THAT FMAXSN * FOF I J ( IMAXSN, JMAXSN) I 
IS GRTHN* FOFIJCItJ) FOR 1*1. ..LI, J*1...LJ WHERE CALLER HAS 
DIMENSION FOFIJ( IDIMEN, IGNORDI. FOFIJ MAY BE FIXED OR FLOATING. LI 
AND LJ MUST EXCEED ZERO, AND IDIMEN GRTHN* LI (NOT CHECKEOI. 

MOOT (NRCAB,LAB, AA, BB, DOT,MIFREV ) FORTRAN, 109 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - MATML1. 
SETS DOTM * MATRIX PRODUCTS A(1)«B(1) ♦ ... ♦ A ( LAB I #B ( LAB I IF 
MIFREV GRTHN* 0, OR * MATRIX PRODUCTS A(1)*B(LA8) ♦ ... 
♦ A(LAB)»B(1) IF MIFREV LSTHN 0 . A(I) REPRESENTS THE NRCAB BY 
NRCAB MATRIX STORED BEGINNING AT A A ( 1+NRCAB*NRCAB» ( 1-1 1 1 , Bill 
REPRESENTS THE NRCAB BY NRCAB MATRIX STORED BEGINNING AT 
BB(H-NRCA8*NRCAB*( 1-1)), AND DOTM REPRESETNS THE NRCAB BY NRCAB 
MATRIX DOT( 1. • «NRCAB*NRCAB ) • EQUIVALENCE ( AA,8BI OK. NRCAB, LAB 
MUST BE GRTHN* 1 . 



MD0T3 (NRAD, NCARB,NCBD, LAB, AA, BB, Z I FNTR, DOT, MIFREV) FORTRAN, 122 REGISTERS 
NO OTHER ENTRIES. TRANSFER VECTOR - MATML3. 
SETS DOTM * MATRIX PRODUCTS A(1I«B(1I ♦ ... ♦ A ( LAB I «B ( LAB I IF 
MIFREV GRTHN* 0, OR * MATRIX PRODUCTS A(1)*B(LABI ♦ ... 
+ A(LAB)»B(1> IF MIFREV LSTHN 0 . A(I) REPRESENTS THE NRAD BY 
NCAR8 MATRIX STORED BY COLUMNS BEGINNING AT AA ( l+NRAD*NCARB» ( 1*1 II , 
B(I) REPRESENTS THE NCARB BY NCBD MATRIX STORED BY COLUMNS, IF 
Z I FNTR * 0., OR BY ROWS, IF ZIFNTR NOT* 0., BEGINNING AT 
BB(1+NCARB»NCBD*(I-1M, AND DOTM REPRESENTS THE NRAD BY NCBD 
MATRIX D0T(1...NRA0*NCBDK EQUIVALENCE ( AA, BB ) OK. NRAD, NCARB, 
NCBD, LAB MUST BE GRTHN* 1 (NOT CHECKED I • 



•**•**»»«»*»**»*»**••»** 
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•*«»••*•«*••••*••«»*•*•• 

» MEMUSE TO MINSNM * 
»•*•»*****»*•»*«•»•»•«*• 



MEMUSE (ITPOUT) FORTRAN, 71 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - XLCOMN, ( STHI , ( F I L I . 
PRINTS ONE LINE (COLUMNS 2 THRU 961 ON LOGICAL TAPE ITPCUT GIVING 
(IN DECIMAL) PROGRAM STORAGEt DIMENSIONED COMMON STORAGE, AND AVAILABLE 
COMMON STORAGE. DOES NOT CHECK ITPOUT. 

MFACT ( NRAf AA, AFACT ) FORTRAN, 187 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - DGTJ »STZ, SQRT. 
FINDS THE UPPER TRIANGULAR MATRIX AFACT C 1 .. .NRA*NRA ) SUCH THAT THE 
MATRIX PRODUCT (AFACT * AFACT TRANSPOSE) * AA. NRA MUST BE 
GRTHN= 1 . 

MIFLS (NRC,LL,BB,RR,GG,FF,C) FORTRAN, 276 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - MATML3 ,MOVREV. 
SOLVES THE EQUATION SUM (FROM 1*1 TO LL) OF F(LL-I+l)»R( I-J+l) * 
G(LL-J+1) FOR J*1...LL GIVEN THE SOLUTION FOR THE LOWER ORDER 
EQUATION SUM (FROM 1=1 TO LL-1) OF F 1 ( LL-I+1 ) »R ( I-J+l) = G(LL-J) 
FOR J=1...LL-1 AND THE OTHER INPUTS. BB, RR, GG, AND FF ARE ALL 
NRC BY NRC MATRIX VALUED VECTORS OF LENGTH LL. BB IS THE 
LEAST-SQUARE OPTIMUM HINDSIGHT OPERATOR FOR THE AUTOCORRELATION RR 
(SEE MIPLS). RR(1+NRC*NRC*(I-1) ) * R(I) IS THE AUTOCORRELATION GF 
AN NRC BY M WAVELET (OR STATIONARY TIME SERIES). R(l) REPRESENTS 
THE MIDDLE TERM. GG( 1+NRC»NRC* ( 1-1 ) ) * G(I) IS PART CF A CROSS 
CORRELATION SERIES. FF ( 1. . .NRC*NRC» (LL-1) ) = FK1...LL-1) ON 
ENTRANCE. FF ( I . . .NRC»NRC*LL ) * FU...LL) ON RETURN. 
C(1...6*NRC»NRC) CONTAINS SOME EXPECTED ERROR MATRICES (GIVEN BY 
MIPLS) AND SCRATCH SPACE. NRC AND LL MUST BE GRTHN* 1 . 

MINAB (LX,X,XMIN2,I) FAP, SECONDARY ENTRY OF MAXSN 

SETS XMIN2 AND I, GIVEN XU...LX), SUCH THAT XMIN2 * X(I) WHERE 

MAGNITUDE OF X(I) IS SMALLEST MAGNITUDE OF XU...LX). (NOTE 

XMIN2 MAY BE NEGATIVE.) LX MUST EXCEED 0 . X MAY BE ANY MODE. 

MINABM (FOFIJ, LI, LJ, IDIMEN, FAP, SECONDARY ENTRY OF MAXSNM 

FM INAB, IM INAB, JMINAB ) 
SETS FMINAB, IMINAB, JMINAB SUCH THAT FMINAB * FOFI J ( IMINAB, JMINAB) 
SATISFIES M AGN I TUDE ( FM INAB ) LSTHN* FOFIJ(I,J) FOR 1=1. ..LI, 
J=1...LJ WHERE USER HAS DIMENSION FQFI J( IDIMEN, IGNORD ) • FOFIJ MAY 
BE FIXED OR FLOATING. REQUIRE LI AND LJ GRTHN* 1 AND IDIMEN 
GRTHN= LI (NOT CHECKED). 

MINSN (LX,X,XMIN1,I) FAP, SECONDARY ENTRY OF MAXSN 

SETS XMIN1 AND I, GIVEN XU...LX), SUCH THAT XMIN1*X(I) IS LSTHN* 
ALL OTHER XU...LX). LX MUST EXCEED 0 . X MAY BE ANY MODE. 

MINSNM (FOFIJ, LI, LJ, IDIMEN, FAP, SECONDARY ENTRY OF MAXSNM 

FMINSN, IMINSN, JMINSN) 
SETS FMINSN, IMINSN, JMINSN SUCH THAT FMINSN « FOFI J ( IMINSN, JMINSN ) 
LSTHN* FOFIJ(I,J) FOR 1*1. ..LI, J*1...LJ WHERE USER HAS DIMENSION 
FOFI J( IDIMEN, IGNORD). FOFIJ MAY BE FIXEO OR FLOATING. REQUIRE LI 
AND LJ GRTHN* 1 AND IDIMEN GRTHN* LI (NOT CHECKED). 
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• MIPLS TO MONOCK * 



« MIPLS TO <MGNOCK » 
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MIPLS (NRC,LL,AA,BB,RR,C,ERR) 



FORTRAN, 571 REGISTERS 



NO OTHER ENTRIES. TRANSFER VECTOR - IXCARG,MATINV,MATML3,MATRA, 
M00T3,M0VREV,STZ. 
SOLVES THE EQUATIONS SUM (FROM 1=1 TO LL ) OF A( LL-I+1 J *R ( l-J+l I 

* 0. AND SUM (FROM 1*1 TO LL) OF B ( I ) *R( I- J + l ) * 0. FOR 
J*1...LL GIVEN THE SOLUTIONS TO THE EQUATIONS SUM { FROM 1*1 TO LL-1) 
OF A1(LL-I)»R(I-J*l) * 0. ANO SUM (FROM 1*1 TO LL-1) OF 
Bi(I)*R(I-J+l) * 0. FOR J*1...LL-1, ANO THE EXPECTED ERRORS 

FOR Al AND Bl {SEE BELOW). AA { 1 • • .NRC*NRC*LL ) * AU...LL), 
BB(1...NRC»NRC*LL) * BC1...LL), RR ( 1 . . .NRC*NRC*LL ) * RU...LL), 
AND C(1...4*NRC»NRC) ARE VECTORS OF NRC BY NRC MATRICES. 
AA(1...NRC*NRC«(LL-H) « AHI...LL-U IS THE LEAST-SQUARE OPTIMUM 
PREDICTION OPERATOR, AND BB ( 1 . . .NRC»NRC*f LL-1)) « BK1...LL-1) 
IS THE LEAST-SQUARE OPTIMUM HINDSIGHT OPERATOR FOR THE AUTOCORRELATION 
RR (NOTE THAT RID IS THE CENTER TERM). LET C( 1...4«NRC*NRC ) * 
CMU...4), THEN CM(1) CONTAINS THE EXPECTED ERROR FOR AA, CM(2) 
CONTAINS THE EXPECTED ERROR FOR BB, CM(3) CONTAINS CM(1) INVERSE, 
AND CM(4) CONTAINS CM(2) INVERSE. C( H-4»NRC*NRC . . .NRC*5»NRC»NRC ) IS 
SCRATCH. LL MUST BE GRTHN* 0, NRA MUST BE GRTHN* 1 . ERR * 0. IF 
ALL OK, * 1. IF CMU) OR CM(2) SINGULAR (THEORETICALLY 
IMPOSSIBLE), * 2. IF OVERFLOW OCCURS WHILE INVERTING CMU J OR 
CM(2), = 3. IF LL LSTHN 0 . LL BUMPED UP BY 1 . (THE WRITEUP 
ASSUMES THE NEW VALUE OF LL AS THE LIMITS). 

MISS ( NRC,LL , AA, BB,RR,GG,FF ,C ) FORTRAN, 335 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - MATML3,MD0T3,M0VREV. 
SOLVES THE EQUATION SUM (FROM 1 = 1 TO LL) OF FUL-I + l )*R( I-J+l) * 
G(LL-J+1) GIVEN THE SOLUTION SUM (FROM 1*1 TO LL) OF 

F(LL-I+1)*R( I-J+ll * G(LL-J) FOR J*i...LL AND THE OUTPUTS OF MIPLS 
AA, BB, AND C. SEE THE WRITEUP OF MIPLS FOR AN EXPLANATION OF F, 
R, G, NRC, LL, AA, BB, RR, GG, FF, AND C. 
C(4*NRC*NRC+1...6*NRC*NRC) IS SCRATCH. 

MLISCL (MLIV,LMLIV,ISCALE,MLIVSC,IANS) FAP, 47 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS MLIVSCU...LMLIV) * ISCALE*MLIV( 1. ..LMLI V) ASSUMING ISCALE 
IS FORTRAN INTEGER AND MLIV IS MACHINE LANGUAGE INTEGER VECTCR. 
EQUIV(MLIVSCMLIV) OK. SETS IANS * 0 IF ALL OK, * -1 IF LMLIV LSTHN 1, 

* - 2 IF OVERFLOW OCCURS. 

MLI2A6 ( ML I ,ML IHOL , NCRS ) FAP, 128 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS MLIH0L(1...2) * 12 HOLLERITH ( F0RMATI2A6 ) ) REPRESENTING ML I 
CONSIDERED AS A MACHINE LANGUAGE INTEGER. THE 12 HOLLERITH ARE 
RIGHT ADJUSTED WITH LEADING ZEROES AND PLUS SIGN SUPPRESSED. SETS 
NCRS = NO. NON-BLANK HOLLERITH (INCL. MINUS SIGN IF PRESENT). 

MONOCK (X,LX,ZFNDCR,IANSNG,IANS) FAP, 48 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS IANS * 0 IF LX * 1 OR IF XU...LX) SATISFIES TEST X( I) 
GRTHN* X(I-l) 1*2. ..LX IN THE CASE ZFNDCR * 0.0, OR SATISFIES TEST 
X(I) LSTHN* X(I-i) 1*2. ..LX IN THE CASE ZFNDCR NOT* 0.0, BUT 
SETS IANS * IANSNG IF TEST MADE AND FAILS. PLUS AND MINUS ZERO 
TREATED EQUAL. STRAIGHT RETURN WITH NO OUTPUT IF LX LSTHN* 0 . 



•*»*••*•******•**»•***»* 
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* MOUT TO MOVREV * 
**♦**»»»»**•»»»•»«•«*»«» 



MOUT (ITAPE, NSPACE, X, XNAME , NRX, NCX, LX > FORTRAN, 130 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - CARIGE, IFIL) , < STH) . 
WRITES A VECTOR OF CLOSELY SPACED MATRICES X( 1. • .NRX, I . • . NCX, 1. . .LX I 
ON LOGICAL TAPE ITAPE USING A FIXED G FORMAT WITH 5 VALUES PER 
LINE. THE ARRAY IS PRECEEDED BY NSPACE BLANK SPACES i PAGE IS RESTORED 
IF NSPACE IS NEGATIVE) AND A LABEL CONSTRUCTED FROM THE 6 HOLLERITH 
CHARACTERS IN XNAME. 

MOUTAI (ITAPE, NSPACE, FOF I J,FNAME, L I ,L J, FORTRAN, 357 REGISTERS 

IDIMEN,NDIGS, SCALE, SPACE) 

NO OTHER ENTRIES. TRANSFER VECTOR - CARIGE ,GNH0L2, MAXABM,RND,MCVE , 

MULPLY,FIXVR,SAME,L0G,EXP(2, (FID, CSTH) . 
CREATES NSPACE BLANK LINES ON LOGICAL ITAPE (OR PAGE RESTORE IF 
NSPACE LSTHN 0) FOLLOWED BY A HEADING LINE INVOLVING SIX HOLLERITH 
FROM FNAME ( FORMAT ( I A6 ) ) AND DESCRIBING SCALING USED. THEN PRINTS 
A SCALED AND FIXED FORM OF FOFIJt 1,..LI,.1..LJ), WHERE USER HAS 
DIMENSION FOF I J ( IDIMEN, IGNORD) , COLUMNS OF FOFIJ U.E., FIXED J 
VALUES) BEING PRINTED ALONG OUTPUT ROWS EACH OF WHICH IS LABELLED WITH 
ITS J VALUE AND FOFIJ BEING FLOATING POINT UNLESS SCALE * 0.0, 
WHERE THE USER CONTROLS THE FIELD WIDTH * NDIGSU (THE NUMBER OF 
WORDS PER LINE BECOMES 60,40,30,25, OR 20 ACCORDING AS NDIGS * 1,2,3, 
4, OR 5), AND THE SCALING BY SCALE. IF SCALE * 0.0 FOFIJ IS 
ASSUMED ALREADY FIXED POINT COMPATIBLE WITH NDIGS. IF SCALE GRTHN 
0.0 THE OUTPUT INTEGERS WILL BE ( SCALE*FOF I J I ROUNDED TO NEAREST 
INTEGERS. IF SCALE * -1.0, MOUTAI SCALES 8Y THAT POWER OF TEN WHICH 
WILL GIVE 10**(NDIGS-1) LSTHN* MAXMAG LSTHN 10»«NDIGS WHERE 
MAXMAG IS THE LARGEST OUTPUT MAGNITUDE. IF SCALE = -2.0 MOUTAI 
SCALES SO THAT MAXMAG * 10»»(NDIGS-1I . ORIGINAL MATRIX FOFIJ LEFT 
UNDISTURBED. SPACE ( 1 .. .L 1*1 ) MUST BE AVAILABLE FOR SCRATCH. ITAPE, 
LI,LJ, SHOULD EXCEED 0, ITAPE LSTHN* 20, IDIMEN GRTHN* LI, AND 
NDIGS * 1,2,3,4, OR 5, BUT NONE OF THESE ARE CHECKEO. 

MOVE (N, SOURCE, DEST) FAP, 32 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS DEST(1...N) * SOURCE! 1. * .N) • ALL TYPES OF OVERLAP OF VECTORS 
SOURCE AND DEST ARE PERMITTED. VECTORS CAN BE ANY MODE. STRAIGHT 
RETURN IF N LSTHN 1 . 

MOVECS (LXY1,X1,Y1,...,LXYN,XN,YN) FAP, 24 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - MOVE. 
SETS Y1U...LXY1)*X1(1...LXY1), YN C 1 . . .LXYN ) *XN ( 1. . . LXYN ) . 

EQUIV(XJ,YK) OK FOR ANY J,K. YK UNDISTURBED IF LXYK LSTHN 1. 
VECTORS MOVED IN SAME ORDER AS THEY APPEAR IN CALLING SEQUENCE. 

MOVREV (LXY,IX,X,IYMIFR,Y,SIGNI FAP, 74 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
MOVES X(l), XU + IX), XU + CLXY-L)*IX) TO Y(l), Ytl+IY),..., 

YU+(LXY-1)*IY) WHERE IY * ABSOLUTE VALUE OF IYMIFR. IF I YMIFR 
LSTHN 0, THE STORAGE ORDER IS REVERSED WHILE MOVING. IF SIGN LSTHN* 

0. , THE SIGN IS CHANGED WHILE MOVING. ROUTINE RETURNS IF LXY LSTHN 

1, IX LSTHN 0 . OVERLAP MAY OCCUR ONLY IF IX * IYMIFR * 1 . 
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« MPSEQ1 TO MULPLY * 
•**••••»**•»•**••••*•••• 



MPSEQ1 (X,LX, B,LB,IX,IXLO,IANS) 



FAP, HO REGISTERS 



NO OTHER ENTRIES. NO TRANSFER VECTOR. 



SETS IXI1...LX) FROM 


Xd. 


..LX), 


BI1...LB) 


AND 


IXLO AS 


FOLLOWS - 


SETS IXm TO EQUAL 






CONDITION 


ON Xd) 




IXLO 








X( I) 


LSTHN 


8C1) 


IXLO 




BCD 


LSTHN* 


X( I) 


LSTHN 


B(2) 


IXLG+i 




B(2) 


LSTHN* 


Xd) 


LSTHN 


8(3) 


ETC. 














IXLO+LB-2 




B(LB- 


1) LSTHN* 


X C I ) 


LSTHN 


B (LB ) 


IXLO+LB-2 




B(LB) 


LSTHN* 


Xd) 






ASSUMING LX, LB GRTHN* 


1 AND 


BC Jl 


GRTHN B(J-1> 


. X 


AND B CAN 





BE ANY MODE AS LONG AS THEY ARE SAME MODE. SETS IANS * 0 IF ALL OK, 
* -1, -2 OR -3 IF ILLEGAL LX, LB OR WEIRD ERROR. 



FORTRAN, 61 REGISTERS 



MRVRS (NRA,NCA,LA,AA) 

NO OTHER ENTRIES. TRANSFER VECTOR - REVERS. 
REVERSES THE STORAGE ORDER OF THE VECTOR AA ( 1 . . . NRA*NCA»LA ) OF 
NRA BY NCA MATRICES. NRA, NCA, AND LA MUST BE GRTHN* 1 , 



MSCON1 (NORDER,P, PHI, DEPEND, IANS) FORTRAN, 238 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS PHI * MEAN SQUARE CONTINGENCY AND DEPEND * DEPENDENCY MEASURE, 
GIVEN SECOND PROBABILITY MATRIX P( 1 • • .NORDER, 1. • .NORDER ) WITH 
DIMENSION P(25,25) NORMALIZED SO SUM (OVER I AND J) OF P(I,J) * 1.0, 
AND CONSTRAINED SO SUM (OVER I OR OVER J) OF Pd,J) IS NOT 
* 0. FOR ANY J OR I. SETS IANS * 0 IF ALL OK, * -1 IF NORDER 
OUTSIDE RANGE I. ..25, * -2 IF ILLEGAL P MATRIX. 

MULK (C,Xl,X2,...,XN) FAP, SECONDARY ENTRY OF ADCK 

SETS X1*X1*C, X2*X2*C, XN*XN*C. EQUI V( ANY ARGUMENTS) OK, BUT 

INITIAL VALUE OF C IS ALWAYS THE MULTIPLIER. STRAIGHT RETURN IF N*0. 

MULK (C,X1,X2,...,XN) - II FORTRAN, 76 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - SETUP, ARG, STORE, RETURN. 
SAME FUNCTION AS FAP VERSION OF MULK 

MULKS (CI,X1,Y1,C2,X2,Y2,...,CN,XN,YN) FAP, SECONDARY ENTRY OF ADCK 

SETS YI*XI*C1, Y2*X2»C2, YN*XN»CN. EQUI V( ANY TWO ARGUMENTS) 

OK BUT MAY CHANGE INPUTS CJ OR XJ. PROCESSING IS LEFT TO RIGHT. 
STRAIGHT RETURN IF N*0. 



FORTRAN, 757 REGISTERS 



MULLER (C0E,N1,R00TR,R00TI ) 

NO OTHER ENTRIES. TRANSFER VECTOR - SQRT. 
FINDS THE REAL AND COMPLEX ROOTS ROGTR! I. . .Nl ) , ROGTI I 1 . . . Nl ) 
REAL VALUED POLYNOMIAL COE ( i . . .Nl+l ) . Nl GRTHN* 1 . 



FOR A 



MULPLY (X,LX,XMLPLR,XMLPLD) FAP, 34 REGISTERS 

OTHER ENTRY - XMLPLY. NO TRANSFER VECTOR. 
SETS XMLPLDI1...LX) * X( 1 . . . LX ) »XMLPLR. EQUI V( X, XMLPLD ) OK, AND 
EQUIVUMLPLR, SOME Xd)) OK, BUT INITIAL VALUE OF XMLPLR IS ALWAYS 
THE MULTIPLIER. STRAIGHT RETURN IF LX LSTHN 1. 



**«•**»*•*»*»***»**•**»* 

* MUVADD TO MVSQAV * 
*»•*»**»*»•«*»*»»»#•»**» 



PROGRAM DIGESTS 



*•»»•• *•«•••• »#**# •*•••• 

* MUVADD TO MVSQAV • 
**»•»»»*»**•••• ••»•«•**• 



MUVADD (IV, ILO, IHI, LADD, MUVSUM,NSUMS, IANS) FAP, 129 REGISTERS 

NO OTHER ENTRIES* NO TRANSFER VECTOR* 
SETS MUVSUMU...NSUMS) AND SETS NSUMS * IHI-IL0+2-LADD, WHERE 
MUVSUM(l) » IV(ILG)*IV( ILO+1 )♦...♦ I V( ILO+LADD-l) 
MUVSUM(2) » IV( ILO+l)+IV( ILO+2) + . . . + IV ( ILOH.AODI 
ETC. 

MUVSUM(NSUMS)=IV(IHI-LADD+l)+...+IV( IHI-1)*IV( IHI) 
SUBJECT TO 0 LSTHN ILO LSTHN^IHI, AND LADD GRTHN 0 . SETS 
IANS s o IF ALL OK, = 1 IF LADD EXCEEDS IHI-ILO+1 (OTHERWISE IT 
TREATS THIS CASE AS THOUGH LADD * IHI-ILO+i), « -1 IF ILO, IHI OR 
LADD ILLEGAL, « -2 IF OVERFLOW (ALL SUMS COMPUTED ANYWAY ) • 

MVBLOK (NN, ISORCE, IDEST) FAP, 19 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS DESTI1...NN) = SORCE ( 1 . . . NN ) GIVEN ISORCE = MACHINE ADDRESS 
OF SORCE(l), IDEST * MACHINE ADDRESS OF DEST(l), AND NN. THE VECTORS 
SORCE AND DEST MAY OVERLAP ONLY IF ISORCE EXCEEDS IDEST. 



MVINAV (REC,LREC,K,RECAV, IANS ) FORTRAN, 221 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS RECAVU...LREC) WHERE RECAV(I) « ( l/( 2K + 1 1 l»SUM (FROM J * I-K 
TO I+KI OF REC(J), WHERE COMPUTATIONS MADE AS THOUGH REC(J> WERE ZERC 
OUTSIDE 1...LREC. LREC MUST EXCEED 0, K IS GRTHN* 0, AND (2*K+1) MUST 
BE LSTHN LREC (UNLESS K=0). SETS IANS = 0 IF ALL OK, * -2 OR -3 FOR 
ILLEGAL LREC OR K. 



MVNSUM (X,LX, LSUM, DVSR,SUMOVD, LSUMOD) FAP, 71 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS LSUMOD * LX-LSUM+1 ANO SUMOVD(I) - (1/DVSRI « (SUM (FROM 
J*I TO IH.SUM-1) OF X(J) > FOR 1*1, 2,... , LSUMOD. EQUIVALENCE 
(X,SUMOVD) OK. STRAIGHT RETURN WITH NO OUTPUT IF LX GR LSUM 
LSTHN 1, OR IF LSUM GRTHN LX. 

MVNTIN (X,LX, DEL, LINT, XMI,LXMI) FAP, 88 REGISTERS 

OTHER ENTRY - MVNTNA. NO TRANSFER VECTOR. 
SETS LXMI « LX-LINT+1, AND SETS XMHI) * DEL ♦ ( XUJ/2.0 
+ { SUM (FROM J»I*1 TO I+LINT-2) OF X(J) ) + X( I+LINT-ll /2.0 I FOR 
1=1.. .LXMI, EXCEPT STRAIGHT RETURN WITH NO OUTPUTS IF LX OR LINT 
LSTHN 2, OR IF LINT GRTHN LX. EQUIVALENCE (X,XMI) AND 
EQUIVALENCE (LX.LXMI) PERMITTED. 

MVNTNA (X,LX, DEL, LINT, XAMI, LXAMI) FAP, SECONDARY ENTRY OF MVNTIN 

SETS LXAMI * LX-LINT+1, AND SETS XAMKI) » DEL • ( XA(I)/2.0 
♦ (SUM (FROM J*I*1 TO I+LINT-2) OF XA(J) ) ♦ XA( I+L INT-1 ) /2.0 ) 

FOR 1=1. ..LXAMI, WHERE XA(I) * ABSOLUTE VALUE OF X(II, EXCEPT 

STRAIGHT RETURN WITH NO OUTPUT IF LX OR LINT LSTHN 2, OR IF LINT 

GRTHN LX. EQUIVALENCE (X,XAMI) AND EQUIVALENCE (LX, LXAMI) 
PERMITTED. 



MVSQAV (RECLRECK, RECAV, IANS I FORTRAN, 236 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS RECAV(1...LREC) WHERE RECAV( I) = ( 1/ ( 2K+1 ) ) *SUM (FROM J=I-K 
TO I+K) OF REC( J)*R£C( J), WHERE COMPUTATIONS MADE AS THOUGH RECUI 
WERE ZERO OUTSIDE 1...LREC. LREC MUST EXCEED 0, K IS GRTHN = 0 AND 
(2*K+1) MUST BE LSTHN LREC (UNLESS K=0). SETS IANS * 0 IF ALL OK, * -2 
OR -3 FOR ILLEGAL LREC OR K. 



«•*»»*»••******•»»»»*»*• 

* MXRARE TO NRMVEC * 
*»#«**»*»»«»***»•»••»»»* 
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***»•»»•**«»*•»',»*••*«•** 
* MXRARE TO NRMVEC « 
*••••»•*•***»*»**•••*••• 



MXRARE ( DN ,DD,LD, DNFRAC, DDFRAC, MNREWI ,RAMX, FORTRAN, 302 REGISTERS 

ILOt IHI, IANS) 

NO OTHER ENTRIES. TRANSFER VECTOR - EXP<2. 
GIVEN DNU...LD), DD(1...LD) WHERE DN AND DD SATISFY DCH-li 
GRTHN = D( I) AND DUD) GRTHN 0(1), MXRARE SETS RAMX, ILO, IHI 
WHERE RAMX * (ONC IHI)-DN( ILO) )/ (DDI IHI)-DD( ILO)) AND ILO, IHI ARE 
CHOSEN TO MAXIMIZE RAMX, SUBJECT TO THREE CONSTRAINTS 1) (DN(IHI)- 
DN(ILO)/(DN(LD)~DN(in MUST BE GRTHN* DNFRAC, 21 ( DD ( IHI )-DD C I LOI ) / 
( DDI LD)-DD( i ) ) MUST BE GRTHN* DDFRAC, AND 3) (IHI-ILO) MUST BE GRTHN* 
MNREWI . DNFRAC AND DDFRAC MUST LIE IN CLOSED RANGE 0. TO l.C, 
MNREWI IS GRTHN 0 AND LSTHN LD. IN CASE OF ZERO DENOMINATORS, 0/0 IS 
TAKEN * 0 AND K/0 IS TAKEN * 10 EXP 35 (AND CHOSEN AS MAXIMUM). 
SETS IANS * 0 IF ALL OK, = -1, -2,... OR -6 FOR ILLEGAL DN,DD,LD, 
DNFRAC, DDFRAC OR MNREWI, * 1 IF A 0/0 RATIO FOUND, * 2 IF A K/0 RATIO 
FOUND (SUPERCEDES IANS * 1 CASE). 



NEXCOSF( DUMMY ) FAP, SECONDARY ENTRY OF SEQSAC 

HAS VALUE * COS ( ARGLO-M NTIMES- 1 )*ARGDEL) WHERE NTIMES * NUMBER OF 
TIMES NEXCOSF HAS BEEN USED PRIOR TO PRESENT USE AND SUBSEQUENT TO THE 
LAST CALL SEQSAC ( ARGLO , ARGDEL ) STATEMENT. DUMMY IS IGNORED. 

NEXSINF ( DUMMY ) FAP, SECONDARY ENTRY OF SEQSAC 

HAS VALUE * SIN(ARGL0+(NTIMES-1)*ARGDEL) WHERE NTIMES * NUMBER OF 
TIMES NEXSINF HAS BEEN USED PRIOR TO PRESENT USE AND SUBSEQUENT TO THE 
LAST CALL SEQSAC ( ARGLO , ARGDEL ) STATEMENT. DUMMY IS IGNORED. 



NMZMG1 (LX,X,XMAX, SCALE) FAP, 34 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XU...LX) * C»X(1...LX) AND SETS SCALE * 1/C, WHERE C * 
XMAX/ (MAGNI TUDE OF THAT X(I) INPUT VALUE WHICH HAS LARGEST MAGNITUDE). 
IF XMAX*0. IT SETS SCALE*0. AND X(1...LX)*0. LX SHOULD EXCEED 0 . 

N0INT1 (X,PROB) FAP, 369 REGISTERS 

OTHER ENTRY - N0INT2. TRANSFER VECTOR - LINTR1. 
SETS PROB * (1/SQRT(2PIH»INTEGRAL (FROM MINUS INFINITY TO X) 
OF (EXP(-(X**2)/2)DX). 



N0INT2 (XMEAN,XSD,NDIV,XDIV,IANS) FAP, SECONDARY ENTRY OF N0INT1 

SUPPOSE P(X) IS UNIT AREA NORMAL DISTRIBUTION WITH MEAN XMEAN AND 
STANDARD DEVIATION XSD. THE N0INT2 SETS XDI V( 1. . .NDIV-i ) SO THAT 
THE INTEGRAL OF P(X) FROM XDIV(I) TO XDIV(I*i) IS CONSTANT 
(= 1/NDIV) FOR I * 0,1,...,NDIV-1 WHERE XDIV(O) AND XOIV(NDIV) ARE 
IMPLIED TO BE - AND ♦ INFINITY RESPECTIVELY. SETS IANS * 0 IF ALL 
OK, = 1 OR 2 FOR ILLEGAL XSD (LSTHN* 0.1 OR NDIV (LSTHN 2). 

NRMVEC (ZIFRMS, SCALE, X,LX, XMEAN, XMAX, XNRM) FORTRAN, 111 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - MAXAB, SQRT. 
SETS XNRM(I) = X(I)»SCALE/XMAX * XMEAN FOR 1*1. ..LX WHERE XMAX * 
1/LX TIMES THE SQUARE ROOT OF SUM (FROM 1*1 TO LX) OF X(I)»X(II 
IF ZIFRMS * 0., OR * ABSOLUTE VALUE OF MAXIMUM OF XU) 1*1. ..LX 
IF ZIFRMS NOT* 0. LX MUST BE GRTHN* 1 . EQUIVALENCE (X,XNRM) OK. 



•*****•»*»**•*»**»»••»** 

♦ NTHA TO OUDATA * 
••»»»»•**»»»»»••#*•*»**• 
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*»•••••»••**••»•*•««•«** 

« NTHA TO OUDATA » 
•»*•••»•*•»•»•»«•**••**• 



NTHA F(N,A1,A2,...,AN,... ) FAP, 11 REGISTERS 

OTHER ENTRY - XNTHA. NO TRANSFER VECTOR. 
HAS VALUE = AN WHERE AN = N-TH ARGUMENT FOLLOWING N, EXCEPT 
VALUE = N IF N LSTHN* 0 AND VALUE IS UNPREDICTABLE IF N*l 
EXCEEDS ARGUMENT COUNT. 

NURINC (YOFX,LY, XLO, XHI , LYNU, XLONU, FAP, 121 REGISTERS 

XHINU, IERRl , YOFXNU, I ANS ) 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS YOFXNUU...LYNU) * VALUES LINEARLY INTERPOLATED FROM 
YOFX(l...LX) WHERE YOFX(I) CORRESPONDS TO Y( XLO* II- 1 MDELX) WITH 
DELX * (XHI-XLO)/(LY-l) AND WHERE YOFXNUU I CORRESPONDS TO 
Y(XLONU+(I-l)*DELXNU) WHERE DELXNU * ( XHINU- XLONU )/( LYNU-1 ) . REQUIRE 
LY GRTHN* 2, XHI GRTHN XLO, LYNU GRTHN* 1, XLO LSTHN* XLONU 
LSTHN= XHI, AND (ONLY IF LYNU GRTHN* 21 XLONU LSTHN XHINU 
LSTHN* XHI. SETS IANS*0 IF ALL OK, * IERR1+K-1 K * 2,4,5,6, OR 7 
IF LY, XHI, LYNU, XLONU, OR XHINU ILLEGAL. 

NXALRM (JOB, MLIV, ILO, IHI , LEVEL, LTENSE, FORTRAN, 243 REGISTERS 

IBGIN,IEND,ISUM,IANS> 

NO OTHER ENTRIES. TRANSFER VECTOR - FASCN1. 
SCANS MLIVULO...IHI) LOOKING FOR A BLOCK OF AT LEAST LTENSE 
CONTIGUOUS ELEMENTS ALL OF WHICH ARE GRTHN* LEVEL (MLIV AND LEVEL 
ARE FXD.PT. WITH ARB. BINARY POINT POSITION). IF JOB * 0 AND IF 
BLOCK IS FOUND NXALRM SETS IBGIN AND IEND SO THAT MLIVIIBGIN... I END) 
DEFINES THE BLOCK, AND SETS ISUM * SUM OF BLOCK ELEMENTS (OVERFLOW 
IGNORED). IF JOB = 1 THE SETTING OF IEND AND ISUM IS SUPPRESSED. 
SETS IANS * 0 IF NO BLOCK FOUND (IN THIS CASE IBGIN, IEND, ISUM ARE 
SET * 0), * 1 IF FOUND AND SPECIFIED, = 2 IF POSSIBLE BLOCK WAS 
STARTING BUT RAN OFF END OF MLIV BEFORE TRUE IEND LOCATED (IN THIS 
CASE IEND SET * IHI, ISUM * SUM FROM IBGIN TO IHII, * -1 IF ILLEGAL 
ILO (LSTHN 1), IHI (LSTHN ILO) OR LTENSE (LSTHN I), * -99 IF 
UNEXPECTED ERROR FROM FASCN1. 

ONLINE (ISENSE) FAP, 134 REGISTERS 

OTHER ENTRIES - ( STH ) , ( STHD ) , ( STHM ) . TRANSFER VECTOR - (FID, 
(IOH),(RCH),(SPH), (TES),(WER),(WRS) ,(WTC). 
CAUSES ALL MATERIAL THAT IS WRITTEN ON AN OUTPUT TAPE TO BE PRINTED 
ONLINE (1) IF ONLINE HAS 8EEN CALLED, AND (21 IF SENSE SWITCH 
ISENSE IS DOWN. 

OUDATA ( ITAPE, IRECN0,N0PTS,DATA,MODCOD, FORTRAN, 495 REGISTERS 

6HNAUXL1 , L AUXL1 , AUXL 1 , . . . , 6HNAUXLN , LAUXLN, AUXLN ) 

NO OTHER ENTRIES. TRANSFER VECTOR - VARARG ,LOC ,MVBLOK, FAPSUM,PAKN, 
(STB),(WLR),(EFT). 
WRITES ONE BINARY FILE ON LOGICAL TAPE ITAPE FOR FUTURE RETRIEVAL BY 
SUBROUTINE INDATA. FILE WILL CONTAIN DATA ( 1 . . .NOPTS ) PACKED 
MODCOD WORDS/REGISTER (MODCOD LIES IN CLOSED RANGE I. ..18) , THE 
RECORD NO. IRECNO (ANY MODE), AND SOME CONTROL INFORMATION. THE 
ARGUMENT TRIPLETS BEYOND MODCOD WHICH SPECIFY AUXILIARY INFO ARE 
OPTIONAL. IF PRESENT THE FILE WILL ALSO CONTAIN THE N VECTORS 
AUXL 1 ( 1 . • .LAUXL1 ) ... AUXLN ( 1. . .LAUXLN ) AND THEIR NAMES (INDICATED HERE 
AS HOLLERITH) 6HNAUXL1 , • • • , 6HNAUXLN. NOPTS MUST EXCEED 0 . 

(CONTINUED NEXT PAGE) 
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••«•»»»•••••»*••••»«•••* 

» OUDATA TO PLANSP * 
•«•••»*•«•••••••••*••••* 



DATAU...NOPTS) MUST BE FLTG.PT. ONLY IF MODCOD EXCEEOS 1 (IN WHICH CASE 
DATAU...NOPTS) IS DESTROYED ON OUTPUT). THE AUXIL INFO IS ANY MODE < IT 
IS NEVER PACKED) SUBJECT TO CONSTRAINTS 1) N LSTHN 31, AND 21 SUM OF 
LAUXL VALUES LSTHN* 198-2*N . 

PACDAT ( I TAPE, NWORDS, IFSTWDt I FOLD, DAT A, LDATA, I ANS) FAP, 152 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - ( IOS ) , C TCO I , IRDS I , (RCH i , I ETT I . 
READS EVERY IFOLD-TH WORD, BEGINNING WITH THE IFSTWD WORD, FROM A 
BINARY RECORD ON LOGICAL TAPE ITAPE UNTIL A TOTAL OF NWORDS WORDS 
ARE READ. THE WORDS ARE STORED IN FORTRAN ORDER IN DATA ( 1 . . . LDATA ) 
WHERE LDATA IS THE ACTUAL NUMBER OF WORDS READ. SETS I ANS =C IF 
ALL OK, =1 IF AN END-OF-FILE MARK IS ENCOUNTERED, =2 IF A 
REDUNDANCY IS ENCOUNTERED, * -1 IF ITAPE LSTHN 1, * -2 IF 
NWORDS LSTHN 1, * -3 IF IFSTWD LSTHN 1, * -4 IF IFOLD LSTHN 
1 . IF ONE RECORD IS SHORTER THAN IFSTWD+I NWORDS-1 I » IFOLD, MORE 
RECORDS WILL BE REAO UNTIL THE DESIRED NUMBER OF WOROS IS FOUND. 
HOWEVER PHASING ERRORS MAY OCCUR AT THE RECORD GAPS. THE TAPE IS LEFT 
POSITIONED AFTER THE LAST RECORD READ, AFTER THE END-OF-FILE MARK IF 
IANS * It OR AFTER THE RECORD CONTAINING A REDUNDANCY IF IANS = 2 . 

PAKN <N,LD,D, SCALE) FAP, 78 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - FXDATA. 
SETS D(i... (LD+N-D/N) AS SCALED, ROUNDED, FIXED, AND PACKED FORM OF 
FLTG.PT. INPUT DU...LD). PACKING IS N WORDS PER REGISTER (RIGHT 
TO LEFT) WHERE 1 LSTHN* N LSTHN* 18 . SETS SCALE * VALUE BY WHICH 
DATA { I ) MULTIPLIED BEFORE FIXING. IF LD*1, DATAU...LD) AND SCALE 
UNDISTURBED. PAKN AND UNPAKN ARE (APPROXIMATE) INVERSES. 

PLANSP ( JOB, NRA, NCA, AA, MRS, JMAXR, MCS, FORTRAN, 1169 REGISTERS 

JMAXC, SPT,SPACE1,SPACE2, IANS) 

NO OTHER ENTRIES. TRANSFER VECTOR - SETKS, LIMITS, IXCARG, CHOOSE , 
X00ZE,M0VREV,STZ,R0AR2,XADDKS,K0LAPS,C0STBL,SINTBL,XADDK,C0SIS1, 
MATRA. 

SETS SPT(1...(2*JMAXR*1)*( JMAXC+i) ) = SP ( -JMAXR. . . JMAXR ,0 . . . JMAXC ) 
WHERE SP(I,J) * SUM (FROM X*-XL TO XL) OF SUM (FROM Y=-YL TO YD 
OF ( A(X,Y) ♦ COS(I*X*PI/MRS ♦ J»Y*PI/MCS) ) IF JOB * 1, OR WHERE 
SP(I,J) * SUM (FROM X=-XL TO XL) OF SUM (FROM Y=~YL TO YD OF 
( A(X,Y) * SIN(I»X*PI/MRS + J*Y*PI/MCS) ) IF JOB = -1 GIVEN 
AA(1...NRA*NCA) * A(-XL . . . XL , YM. . . YL ) WHERE YM * 0 IF NCA ODD, 
* .5 IF NCA EVEN. SETS IANS(l) * 0 IF ALL OK, * 1 IF JOB 
GRTHN 1 OR LSTHN -1, * 2 IF NRA LSTHN 1, * 3 IF NCA 
LSTHN 1, * 4 IF MRS LSTHN 1, * 5 IF MCS LSTHN 1, * 6 IF 
JMAXR LSTHN 1 OR GRTHN MRS, * 7 IF JMAXC LSTHN 1 OR GRTHN 
MCS. SETS IANS(2) * LSP1 AND IANSI3) * LSP2 WHERE 
SPACEK1...LSP1) AND SPACE2 ( 1 . . . LSP2 ) ARE NEEDED FOR SCRATCH. 
IF JMAXR = MRS * JMAXC * MCS = NRA/2 * NCA/2 * M THEN LSP1 LSTHN* 
8*M*M*9«M+5 AND LSP2 LSTHN* 2*M*M*-3*M+1 (SEE ABSTRACT FOR DETAILEC 
DEFINITION). EQUIVALENCE (AA, SPACED, (SPT,SPACE2) ALLOWED. 
IF JOB * 0 NO COMPUTATIONS ARE MADE AND ONLY IANSU...3) IS 
RETURNED AS AN OUTPUT. 



**»•»»•»»•»•*»•»***»•••• 
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*•••*•*••••••*»»•****«•# 

* PLOTVS TO f>LTVSl » 
•*••«**•*»••*••»••*«»•«* 



PLOTVS 1 1 TAPE t lSENSE,LOCYV, YSMBV,LYV, IXSTRV»NY» FORTRAN, 494 REGISTERS 

ARGLO, ARGDEL, ZFAFXO, FMTARG, NCOLS, YBOT, 
YTOP ,HLINV,HLSM8V,NHL ) 

NO OTHER ENTRIES. TRANSFER VECTOR - RND, SETKS, SETKV, SETVEC, (F I L ) , 
(SPH), (STH), SWITCH. 
CREATES, ON LOGICAL ITAPE (SUPPRESSED IF ITAPE LSTHN* 0) WITH 
ON-LINE MONITORING OPTION (WHILE SENSE SWITCH ISENSE IS DEPRESSED 
PROVIDED ISENSE*!. ..6) OR DEFINITE ON-LINE OUTPUT (FOR ISENSE GRTHN* 
7), A PLOT (THE PLOTTING FIELD OCCUPYING NCOLS COLUMNS BEGINNING 
IMMEDIATELY AFTER THE LAST COLUMN USED ACCORDING TO FMTARG WHICH IS A 
1A6 FORMAT WITHOUT PARENTHESES FOR PRINTING ROW LABELS ARGLO, 
ARGLO+ARGDEL, ARGLO+2* ARGDEL , ... BEGINNING IN COLUMN 2 WHERE ZFAFXD 

* 0.0 IMPLIES ARGLO, ARGDEL ARE FIXED, NOT* 0.0 IMPLIES FLOATING) 
OF THE NY VECTORS Yl ( I . . . LYV ( 1 }) , Y2 ( 1. . . LYV( 2 ) ) , 

YNY(1...LYV(NYII WHOSE MACHINE ADDRESSES ARE GIVEN IN LOCYV( 1. . . NY ) , 
WHERE EACH ELEMENT OF YSMBV( 1. . .NY) GIVES A 1A1 HOLLERITH CHARACTER 
TO USE FOR THE CORRESPONDING VECTOR, WHERE IXSTRV( 1. . .NY) GIVES THE 
OUTPUT ROW INDEX ( GRTHN* 1) AT WHICH THE PLOTTING OF THE 
CORRESPONDING VECTOR IS TO START (LAST ROW INDEX USED IS MAX OVER I 
OF (LYV(I)*IXSTRV(I)-1)), WHERE YBOT and ytop are values of Y TO 
BE ASSOCIATED WITH FIRST AND LAST COLUMNS OF PLOTTING FIELD RESPECTIVELY 
(YTOP LSTHN YBOT IS OK), VALUES OF Y BEING IGNORED IF THEY FALL 
OUTSIDE THESE LIMITS, AND WHERE AN « IS USED EACH TIME TWO OR MORE 
VECTORS INTERSECT. IF NHL * 0 JOB IS DONE. OTHERWISE HL INV( I. . .NHL ) 
GIVES Y VALUES AT WHICH HORIZONTAL LINES (WHEN VIEWED WITH PAGE 
COLUMNS HORIZONTAL) ARE TO BE DRAWN WITH CORRESPONDING IA6 CHARACTERS 
IN HLSMBVU...NHL), VECTOR CHARACTERS TAKING PRECEDENCE OVER 
HORIZONTAL LINE CHARACTERS IN CASES OF INTERSECTION. REQUIREMENTS NY 
GRTHN* 1, LYV(I> GRTHN* 1, (NCOLS+1 ♦ NO. COLUMNS IMPLIED IN 
FMTARG) GRTHN* 132, YTOP NOT* YBOT, IXSTRV(I) GRTHN* 1, AND 
LEGITIMACY OF LOCYV, YSMBV, HLSMBV VECTORS ARE NOT CHECKED. 

PLTVS1 (ITAPE, ISENSE, ARGLO, ARGDEL, ZFAFXD, NCOLS, FORTRAN, 817 REGISTERS 

ZFZERS,RMSSEP,S,LX,ZFLIST,VMATRX,IDIMEN,NX) 

NO OTHER ENTRIES. TRANSFER VECTOR - BOOST, DPRESS,MAXSN,MINSN, 
MULPLY, PLOTVS, RMSDEV,SETKS, SETKVS, SET VEC»VARARG,XLOC, XSAME, XSTL IN , 
(FID, (STH). 

CREATES, ON LOGICAL ITAPE (SUPPRESSED IF ITAPE LSTHN* 0) WITH 
ON-LINE MONITORING OPTION (WHILE SENSE SWITCH ISENSE IS DEPRESSEO 
PROVIDED ISENSE*1...6) OR DEFINITE ON-LINE OUTPUT (FOR ISENSE GRTHN* 
7), A PLOT (THE PLOTTING FIELD OCCUPIES NCOLS COLUMNS BEGINNING IN 
COLUMN 6 IF ZFAFXD * 0.0 OR COLUMN 14 IF ZFAFXO NOT* 0.0, 
COLUMNS 2,3, ...5 OR 13 CONTAINING ROW LABELS ARGLO, ARGLG+ARGDEL, 
ARGL 0+2* ARGDEL, ... IN FORMAT ( 14) OR (E12.5) ACCORDING AS ZFAFXD 

* 0.0 OR NOT* 0.0) OF THE NX VECTORS XK1...LX), X2U...LX), 
XNXU...LX) WHICH, IF ZFLIST NOT* 0.0, ARE SUPPLIED IN THE MATRIX 
VMATRX(i...LX,l,,,NX) WHERE USER HAS DIMENSION VMATRX( IDIMEN, IGNORD) , 
BUT WHICH, IF ZFLIST * 0.0, ARE SUPPLIED BY A LIST OF ARGUMENTS 
X1,X2,...,XNX WHICH SUPPLANT THE ARGUMENTS VMATRX, IDIMEN, NX IN THE 
CALLING SEQUENCE, WHERE THE FIRST NX CHARACTERS OF THE LIST 
1,2,...,9,A,B,...,Z ARE CHOSEN FOR THE CORRESPONDING VECTORS, AND WHERE 
BEFORE PLOTTING, THE VECTORS ARE ALL SCALED TO UNIT RMS VALUE, 
(J-1)*RMSSEP IS SUBTRACTED FROM THE J-TH VECTOR, AND THE PLOTTING 
FIELD IS ADJUSTED SO LARGEST AND SMALLEST X WILL COVER NCOLS 
COLUMNS, EXCEPT THAT THE PLOTTING OF EACH VECTOR WHICH IS IDENTICALLY 

(CONTINUED NEXT PAGE) 
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« PLTVSl TO PLYSYN .« 
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ZERO IS SUPPRESSED (TO ALLOW USER-CONTROLLED SPACING BY UNITS OF 
RMSSEPI. THE TRUE MAXIMA AND MINIMA OF EACH VECTOR, AS WELL AS ITS 
CHARACTER, ARE PRINTED IN A TABLE PRIOR TO THE GRAPHICAL PLOT (WHICH IS 
PRECEDED BY A PAGE RESTORE). AFTER PLOTTING, THE VECTORS ARE RESCALED 
TO THEIR ORIGINAL VALUES. IF ZFZERS NOT* 0.0 THE JOB IS DONE. FOR 
ZFZERS « 0.0 THE PLOT ALSO CONTAINS HORIZONTAL LINES (VIEWED WITH PAGE 
COLUMNS HORIZONTAL) COMPOSED OF PERIOD CHARACTERS INDICATING THE ZERO 
LEVELS FOR EACH OF THE VECTORS. SU...300) REQUIRED FOR SCRATCH. 
NO CHECKING IS MADE ON THE VARIOUS REQUIREMENTS, RMSSEP GRTHN* 0.0, 
LX GRTHN* 1, IDIMEN GRTHN- LX, NX GRTHN* 1 BUT LSTHN* 35, 
AND NCOLS NOT TOO LARGE FOR PRINTER, AND I TAPE NOT EXCESSIVE. 

PLURAL (SUBROU,Al,A2,...,AN,Bl,B2,...,BN, FAP, SECONDARY ENTRY OF SEVRAL 

,Z1,Z2,...,ZN) 

FUNCTION IS EQUIVALENT TO 

CALL SUBRU(A2,A2,...,AN) 
CALL SU8RU(B1,82,...,BN) 
ETC 

CALL SUBRU(Z1,Z2,...,ZN) 

WHERE SUBRU HAS BEEN LOCATED UNDER THE PROXY NAME SUBROU BY A PRIOR 
CALL LOCATE STATEMENT. SUBRU MUST NOT USE DATA BEYOND THE END OF ITS 
CALLING SEQUENCE. 

PLURNS (AI,A2,...,AN,B1,B2,...,BN,......,Z1,Z2,...,ZN) FAP, 73 REGISTERS 

OR 

( Alt A2 ANA, STOP, Bl ,B2, . . . , BNB, STOP, 
,Z1,Z2,...,ZNZ) 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
CALL PLURNS(FIRST ARGUMENT STRING ABOVE) IMMEDIATELY FOLLOWED BY 
CALL SUBRU(N), WHERE N * NORMAL, NON-ZERO ARGUMENT COUNT OF SUBRU, IS 
EQUIVALENT TO 

CALL SUBRU(A1,A2,...,AN) 

CALL SU8RU(B1,B2,...,6N) 
ETC 

CALL SUBRU(Z1,Z2,...,ZN). 
CALL PLURNS( SECOND ARGUMENT STRING ABOVE) WHERE STOP « 0CT777777712345 
IMMEDIATELY FOLLOWED BY CALL SUBRU(O) OR CALL SUBRU IS EQUIVALENT TO 

CALL SUBRU(A1,A2,...,ANA) 

CALL SUBRU(B1,B2,...,BNB) 
ETC 

CALL SUBRU(Z1,Z2,...,ZNZ). 
ANY OF THE ARGUMENT COUNTS NA,N8,...,NZ MAY BE ZERO. LIMITATION - NONE 
OF THE ARGUMENTS IN ONE ARGUMENT GROUP MAY BE EXPRESSIONS INVOLVING 
OUTPUTS OF PREVIOUS ARGUMENT GROUPS EXCEPT FOR PURE EQUIVALENCES. 

PLYSYN (SCALES, RADII, DGREES, NROOTS , PL YCOS, FORTRAN, 170 REGISTERS 

NCOFS, SPACE) 

NO OTHER ENTRIES. TRANSFER VECTOR - COS,CONVLV. 
SETS NCOFS = M+2N+1 AND PLYCOS ( 1. .. NCOFS ) WHERE PLYCOS ARE 
POLYNOMIAL COEFFICIENTS DETERMINED TO HAVE PRESPECIFIED ROOTS (M REAL, 
N COMPLEX CONJUGATE PAIRS, N+M » NROOTS) AND WEIGHTING FACTORS. 
ROOTS GIVEN BY RADI I ( 1 .. .NROOTS ) AND DGREES( 1. . .NROOTS ) WITH WEIGHTS 
SCALES ( 1 . • .NROOTS ) • ROOT CONSIDERED REAL ONLY IF DGREES = 0.0 OR 
EXACT MULTIPLE OF 180., OTHERWISE COMPLEX CONJUGATE INFERRED. 
NROOTS MUST EXCEED ZERO AND SPACE ( 1. .. NCOFS ) NEEDED FOR SCRATCH. 
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POKCT1 (IX,NHANDS,ICT,IANS) FORTRAN, 219 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - FRQCTi. 
TREATS IX(1...5»NHANDS)» WHERE 0 LSTHN « IX(U LSTHN » 9 t AS 
NHANOS POKER HANDS <NON OVERLAPPING GROUPS OF 5) AND SETS ICTU...8I 
* FREQUENCIES OF DIFFERENT TYPE HANDS, WHERE ICTdl* NO. BUSTS, 
ICTC21 * NO. PAIRS, ICT13I - NO. 2-PAIRS, ICT(4> * NO. 3-QF-KINDS, 
ICT(51 * NO. FULL HOUSES, ICT(6) * NO. STRAIGHTS, ICTC7) * NO. 4-GF- 
KINDS, AND ICT(8* » NO. 5-OF-KINDS. SETS IANS = 0 IF ALL OK, * 1 
IF NHANDS LSTHN 1, » 3 IF ERROR RETURN FROM FRQCTI. THE APRIORI 
PROBABILITIES ASSOCIATED WITH ICTC1...8I ARE .2952, .5040, .1080, 
.0720, .0090, .0072, .0045, .0001 . 

POLYDV (N,DVS,M,DVD,L,Q> FORTRAN, 130 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - MOVE,STZ. 
SETS QC1...L) * FIRST L COEFFICIENTS OF QUOTIENT OF POLYNOMIAL 
DVD(l)*DVD(2)*X+...+DVD(M)»X**(M-l> DIVIDED BY POLYNOMIAL 
DVS(l)+DVS(2)»X + ...+DVS(N)*X*»(N-n, WHERE M, N, L MUST BE GRTHN* 1, 
AND DVDC1I NOT » 0. 



POLYEV (N,C,X,A) FORTRAN, 54 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS A * C(ll*Ct2>»X*...+C(N**X**{N-n, WHERE N GRTHN* 1 . 

POLYSN ( SCALE, NQZ, ZRE,ZlM,ZIFCOM, FORTRAN, 256 REGISTERS 

Z I FC N J, L POLY, POLY, SPACE ) 

NO OTHER ENTRIES. TRANSFER VECTOR - SQRT,CONVLV, MOVE, COS. 
SETS LPOLY AND POLY C 1. • .LPOLY) WHERE POLY ARE THE POLYNOMIAL 
COEFFICIENTS DETERMINED TO HAVE THE PRESPECIFIED ROOTS ZREU...NQZ) 
AND ZIMU...NGZ) (NOZ GRTHN* 1). IF ZIFCOM*G., ZRE AND ZIM 
CONTAIN THE REAL AND IMAGINARY PARTS OF THE ROOTS. IF ZIFCOM NOT* 0., 
ZRE AND ZIM CONTAIN THE MAGNITUDE AND THE ARGUMENT IN DEGREES OF THE 
ROOTS. IF ZIFCNJ=0. POLYSN INSERTS A COMPLEX CONJUGATE FOR EACH OF 
THE M NON-REAL ROOTS AND LPOLY * M+NOZ+l . IF ZIFCNJ NOT* 0., THEN 
POLYSN ASSUMES THAT THE COMPLEX CONJUGATE PAIRS OCCUR IN THE LIST AND 
LPOLY * NOZ+1 . THE POLYNOMIAL IS MULTIPLIED BY SCALE AFTER IT IS 
COMPUTED. IF SCALE*0. THE POLYNOMIAL IS SET SO THAT POLY(l) « 1. 
TEMPORARY SPACEi 1. . .2»N0Z) IS NEEDED. 



POWER (X,LX,N,X2NTH) FAP, 50 REGISTERS 

OTHER ENTRY - SMPRDV. TRANSFER VECTOR - EXP (2. 
SETS X2NTHU) - X(I)»*N FOR 1*1. ..LX, WHERE N IS ARBITRARY. 
EQUIV(X2NTH,X) OK. STRAIGHT RETURN IF LX LSTHN 1. 

PRBFIT (NOR, XMOM,NOUT,X,F, PHI, IANS) FORTRAN, 373 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - SQRT,EXP(2,EXP. 
LET FIX) BE A UNIT AREA, ZERO MEAN DISTRIBUTION FUNCTICN, GENERATED BY 
AN EDGEWORTH SERIES, WHOSE HIGHER MOMENTS UP TO ORDER NOR (LSTHN * 6) 
ARE GIVEN BY XM0MC2,3, .. . ,NOR) . THEN PRBFIT SETS FI1...N0UT) * 
VALUES OF F(X) FOR X * XC1...N0UT). PHI (1.. .NOUT) USED FOR SCRATCH. 
SETS IANS * 0 IF ALL OK, = 1 FOR ILLEGAL NOR (LSTHN 2 OR GRTHN 61. 
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PROB2 ( IX,LX,N,IP,P, IXHI, I ANSI 



FORTRAN, 229 REGISTERS 



NO OTHER ENTRIES. NO TRANSFER VECTOR. 
IXU...LX) IS GIVEN INTEGERS WITH VALUES FROM 1 TO IXHI (LSTHN* 25). 
THEN PROB2 SETS P C i ... IXHI , 1 ... IXHI ) AND IP ( 1 . . . I XHI , 1. . . IXHI) 
(DIMENSION PC25, 251, IPC25, 25)1, WHERE P(M,L) * PROBABILITY THAT (IX(KI* 
M AND IX(K*N)=L), P(M,L) BEING NORMALIZED SC SUM OVER M, L * 1.0, AND 
WHERE IP(M,L) * NO. TIMES IT OCCURS THAT (IX(K)* M AND IX(K*N)*L), THE 
COUNTS BEING MADE OVER ALL K, K+N PAIRS SUCH THAT BOTH K AND K+N LIE 
IN CLOSED RANGE 1...LX. N MAY BE NEGATIVE BUT MAGNITUDE (Nl LSTHN LX. 
SETS IANS = 0 IF ALL OK, * -it -2, -3 OR -6 IF ILLEGAL IX VALUE, 
LX, N, OR IXHI, * 3 IF OK BUT N = 0 (P AND IP ARE DIAGONAL). 
EQUIV(P,IP) OK (COUNT MATRIX IP DESTROYED). 

PROCOR (X,LX,MAXX,PR0G1,PR0G2»ERR) FAP, 770 REGISTERS 

OTHER ENTRIES - FASC0R,FASEPC,FASCR1,FASEP1. NO TRANSFER VECTOR. 
XU...LX) ARE MACHINE LANGUAGE INTEGERS WITH MAGNITUDES LSTHN- MAXX 
(1 TO 1000). THEN PROCOR WRITES AN OBJECT PROGRAM WHICH WILL COMPUTE 
CORRELATIONS OF XU...LX) WITH OTHER SERIES, (THE OBJECT PROGRAM TO 
BE OPERATED BY OTHER ENTRIES OF PROCOR). PRGG1 AND PR0G2 DEFINE A 
STORAGE AREA FOR THE OBJECT PROGRAM OF AT LEAST LX*10» (MAXX+1 )U 
REGISTERS, PR0G1 BEING LOWER ABSOLUTE MACHINE ADDRESS, I.E. 
XL0CF(PR0G2)-XL0CF(PR0G1I MUST BE GRTHN* LX*10»( MAXX+1 ) . SETS ERR * 0.0 
IF OK, *1.,2.,3., OR 4. IF STORAGE AREA TOO SMALL, IF LX LSTHN 1, IF 
SOME X(I) MAGNITUDE EXCEEDS MAXX, OR IF MAXX ILLEGAL. 

PSQRT (N,C,M,AI FORTRAN, 155 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - SQRT. 
SETS AI1...M) * FIRST M COEFFICIENTS OF THE POWER SERIES 
A(1)+A(2)»X+A(3)*X*#2+... WHOSF SOIJARF I S A GIVEN POLYNOMIAL C! 1? ^ 
C;CI=n^.trCi«;wA«in-ii, aimu m «U5f EXCEED 0 AND C(l) MUST EXCEED 

0.0 . 

PWMLIV ( JOB, ITAPE,MLIV,LMLIV, IANS) FORTRAN, 300 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - MLI2A6, (STH) , (FID , (SPH) . 
OUTPUTS MLIVU...LMLIV) AS MACHINE LANGUAGE INTEGERS, ONTO LOGICAL TAPE 
ITAPE (VALUE 1...12) IF JOB GRTHN ZERO, THROUGH ONLINE PRINTER (IGNORING 
ITAPE) IF JOB LSTHN ZERO, WHERE MAGNI TUDE( JOB I * DESIRED NO. OF 
WORDS/LINE (GRTHN* 1, LSTHN* 10). FIELD WIDTH OF EACH WORD IS 12. 
SETS IANS * 0 IF ALL OK, * -1, -2, OR -4, FOR ILLEGAL JOB, ITAPE, OR 
LMLIV (MUST EXCEED 0). 

QACORR (X, LX,MXACC,MXLAG, SPACE, ACOR, IANS) FORTRAN, 207 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - FXDATA, PROCOR, FASCCR ,FLDAT A. 
SETS AC0R(1...MXLAG+1) * AC ( 0. . .MXL AG ) WHERE AC(L) * (1/LX)»SUM 
(FROM 1*1 TO I*LX-LI OF X(I»»XU+L>. COMPUTATIONS ARE APPROXIMATE. 
XU...LX) IS CONVERTED TO INTEGER SEQUENCE WITH MAXIMUM MAGNITUDE * 
MXACC (1 TO 1000) DURING COMPUTATIONS, BUT REFLOATED AFTERWARDS (HENCE 
LEFT MORE OR LESS MODIFIED). SPACE( 1. . .LX+10»(MXACC*1 )*1) IS 
SCRATCH AREA. SETS IANS * 0 IF ALL OK, * -2 IF LX LSTHN 1 OR GRTHN 
10000, * -3 IF MXACC ILLEGAL, * -4 IF MXLAG NEGATIVE, * -98 OR -99 IF 
WEIRD ERROR RETURN FROM PROCOR OR FASCOR OCCURS. 
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QCNVLV (XX,LXX,YY f LYY,MXACCtLCC, FORTRAN, 569 REGISTERS 

SPACE, CCIANS) 

NO OTHER ENTRIES. TRANSFER VECTOR - XLOC, FXDATA, PROCOR , FASCOR, 
FASEPCFLDATA. 

SUPPOSE XXU...LXX) CONTAINS X(0. . .LX*LXX-1) AND YYC1...LYYI 
CONTAINS Y(O...LY*LYY-l). THEN QCNVLV SETS CCU...LCC) = 
C(O...LC=LCC-i) WHERE C(J) * SUM (FROM 1*0 TO LX) OF X(I)»Y(J-l>, 
WHERE Y(KI IS TREATED * 0. FOR K OUTSIDE RANGE 0 TO LY. COMPUTATIONS 
ARE APPROXIMATE. XXC1...LXX) AND YYU...LYY) ARE CONVERTED TO INTEGER 
SEQUENCES WITH MAXIMUM MAGNITUDE * MXACC (1 TO 1000) DURING 
COMPUTATIONS, BUT ARE REFLOATED AFTERWARDS (HENCE LEFT MORE OR LESS 
MODI FI ED I • SPACE(1...LMIN+10*(MXACC*1I+1I IS SCRATCH AREA, WHERE 
LMIN = MINIMUM (LXX,LYY). SETS IANS = 0 IF ALL OK, = -2 IF LXX LSTHN 1, 
= -3 IF YY PARTIALLY OVERLAPS XX (HOWEVER EQUIV(XX,YY) IS OK), 
* -4 IF LYY LSTHN 1 OR LMIN EXCEEDS 10000, * -5 IF MXACC ILLEGAL, 
» -6 IF LCC LSTHN i (LCC MAY EXCEED LXX+LYYI, * -99 IF WEIRD ERROR 
RETURN OCCURS FROM PROCOR, FASCOR OR FASEPC. 

QFURRY ( X, LX, I XZER,M, JMIN, JMAX, SPACE, FORTRAN, 244 REGISTERS 

CSP,SSP,IANS) 

NO OTHER ENTRIES. TRANSFER VECTOR - STZ,MOVE ,COSTBL, S I NTBL , XSPECT. 
SETS CSPU...JMAX-JMIN+1) * CS( JMIN.. .JMAX) AND SETS SSP ( 1. .. JMAX- 
JMIN+1) * SS( JMIN. ..JMAX) WHERE 0 LSTHN 35 JMIN LSTHN JMAX LSTHN* M, AND 
WHERE CS(J) * SUM (FROM I=L TO N) OF (XT( I ) *COS ( I*J*P I /M) I AND SSI J) * 
SAME SUM WITH SIN REPLACING COS, AND WHERE L=1-IXZER N=LX-IXZER 
(IXZER IS ARBITRARY, MAY EXCEED LX) AND THE XT SERIES IS GIVEN 
BY XU...LX) « XTR...N). SPACE ( i. . .LSPACE ) NEEDED FOR SCRATCH 
WHERE LSPACE*2»(M+K)*6 WITH K * MAGNITUDE OF L OR OF N WHICHEVER 
GREATER. SETS IANS * 0 IF ALL OK, * -1 IF LX LSTHN 1, * -2 IF 
M LSTHN 1, * -3 IF JMAX OR JMIN ILLEGAL. 

QIFURY ( FTREAL ,FTIMAJ,MFREQ,LX, IXZER, SPACE, X, I ANSI FORTRAN, 280 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - COSTBL,SINTBL,COSISP,XLOC. 
SETS X( II * (1/2»M) * ( SUM (FROM J * -M TO M) OF 
S( J)»COS( J*( I-IXZER)»(PI/M) ) ♦ A(J)»SIN( J» ( I- I XZER ) » ( P I /M) ) ) 
FOR 1 = 1. ..LX GIVEN FTREAL ( 1.. .MFREQ + 1) AND FT I MA J ( 1. ..MFREQ+1) , 
WHERE M*MFREQ , P 1=3. 14159265, S ( 0 , 1 , . . . , M-l ) * FTREAL ( 1 .. .M) , 
S(M)=FTREAL(M+i)/2, S(-l,.. • »-M)*S( 1...M) , A(0...M)=FTIMAJ(1...M+1), 
AND A(-l,...,-M)*-A(l...M). EQUIV(X, FTREAL OR FTIMAJ) OK. 
SPACE(1...4*(M+in NEEDED FOR SCRATCH. SETS IANS*C IF ALL OK, * -1 
OR -2 FOR ILLEGAL MFREQ (LSTHN 1) OR ILLEGAL LX (LSTHN 1). FUNCTICN 
IS INVERSE TO THAT OF QFURRY. 

QINTR1 ( X, XLO, DEL X, TABLE, N TABLE, YOFX) FORTRAN, 229 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - RNDUP,QUF I Tl . 
SETS YOFX = VALUE QUADRAT ICALLY INTERPOLATED FROM THREE TABLE VALUES 
OF TABLE ( 1. • .NT ABLE ) CLOSEST IN CORRESPONDENCE WITH THE ARGUMENT X 
WHERE TABLE ( 1, 2, • • • ) CORRESPOND TO XLO, XLO*DELX, . . . WITH DELX 
GRTHN 0.0, EXCEPT LINEAR INTERPOLATION IS USED FOR NTABLE * 2 . 
HOWEVER, SETS YOFX = 0.0 IF X OUTSIDE LIMITS XLO TO 
XL0+(NDATA-1)*DELX. STRAIGHT RETURN WITH NO OUTPUT IF NTABLE LSTHN* 
1 OR IF DELX LSTHN* 0.0 . 
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QUFIT1 (FOFX,XLG,DELX,COEFS) FAP, 79 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS COEFS(1...3) SUCH THAT THE QUADRATIC F(X) * COEFSU) 
♦ C0EFS<2)»X ♦ COEFS(3)*X*»2 SATISFIES F t XLO)-FOFX ( 1 ) , F(XLO+DELX) 
*FOFX(2), F(XLO+2»DELX)=FOFX(3). HIGH SPEED IF XLG*-1.C AND 
DELX^l.O . STILL FASTER IF DELX IS SET * 0.0 IN WHICH CASE 
COMPUTATIONS MADE AS THOUGH XLO=-1.0 AND DELX'1.0 REGAROLESS OF 
ACTUAL XLO VALUE. 



QXCORR ( X, Y» LXY, MXACC, MXLAG, SPACE, XCOR, IANS) FORTRAN, 283 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - XLOCFXDATA, PRCCOR ,FASCOR, 
FLDATA. 

ASSUME XU...LXY) AND Y(1...LXY) ARE NOT EQUIV. THEN QXCORR 
SETS XC0R(1...2*MXLAG*1) » XU-MXLAG. . .MXLAG) WHERE XC(L) * 
(1/LXY)*SUM (FROM I « 1 TO LXY) OF X(I)»YCI*L!t WHERE Y { K ) IS TREATED 
« 0. FOR K OUTSIDE RANGE 1 TO LXY. IF EQUIVCX,Y) EXISTS THEN 
QXCORR SETS XCOR( 1. • .MXLAG+1 ) = XC ( 0. . .MXLAGI , I.E. ONE SIDE OF 
AUTOCORRELATION. COMPUTATIONS ARE APPROXIMATE. XU...LXY) AND 
Y(l. ..LXY) ARE CONVERTED TO INTEGER SEQUENCES WITH MAXIMUM MAGNITUDE 
* MXACC (1 TO 1000) DURING COMPUTATIONS, BUT ARE REFLOATED AFTERWARDS 
(HENCE LEFT MORE OR LESS MODIFIED). SPACE ( 1 • • .LX Y*1C» (MXACC+1 )♦ 1 ) 
USED FOR SCRATCH. SETS IANS * 0 IF ALL OK, * -2 IF Y PARTIALLY 
OVERLAPS X (£QUIV(X,Y) IS OK), * -3 IF LXY LSTHN 1, * -4 IF MXACC 
ILLEGAL, = -5 IF MXLAG NEGATIVE (MXLAG MAY EXCEED LXY), « -98 OR -99 
IF WEIRD ERROR RETURN OCCURS FROM PROCOR OR FASCOR. 



QXC0R1 (LX, X,LY,Y, MXACC, ILAG,NLAGS, FORTRAN, 502 REGISTERS 

CORR,ZIFSTO,LSPACE, SPACE, IANS) 

NO OTHER ENTRIES. TRANSFER VECTOR - SETKS, IXCARG.L IMTT5.ST7 f 



SETS CORRU...NLAGS) = C( I LAG. • • ILAG+NLAGS-1 ) WHERE CCD = SUM 
( FROM 1=1 TO LX+LY) OF (X( I+L )*Y( I ) ) , WHERE X AND Y ARE 
TAKEN TO BE ZERO OUTSIDE THE RANGE OF DEFINITION. X AND Y ARE ML I 
VECTORS WITH LARGEST ABSOLUTE VALUE LSTHN* MXACC. 1 LSTHN- MXACC 
LSTHN= 1000 . NLAGS MUST BE GRTHN- 1 . ZIFSTO = 0. IMPLIES STORE 
OUTPUT WITHOUT ADDING, NOT* 0. IMPLIES ADD CORRELATION INTO THE OUTPUT 
AREA. SPACEU...LSPACE) IS COMPUTATION SPACE. EQUIVALENCE (X,Y) OK. 
IANS =0 IF NO TROUBLE, * 1 IF LX LSTHN 1, =2 IF LY LSTHN 1, 
=3 IF MXACC LSTHN 1 OR GRTHN 1000, = 4 IF NLAGS LSTHN 1, 
=5 IF LSPACE LSTHN MINI LX, LY) ♦ 1 ♦ 10» (MXACC+1 ) , * 24 IF A VALUE 
OF X OR Y ILLEGAL, = 33 IF OVERFLOW OCCURS. 

RDATA (ITAPE,ITPCPY, IANS, SPACE, FORTRAN, 645 REGISTERS 

X1NAME ,Xi , X2NAME,X2, ... ) 

NO OTHER ENTRIES. TRANSFER VECTOR - ARG, CMPRA ,HVTOI V , INTHOL, 
I VTOHV, I XCARG, RETURN, SETUP, STORE, (F ID , (RTN) , ( STH) , ITSH ) . 
READS DATA CARDS IN FLEXIBLE FORMAT FROM LOGICAL TAPE ITAPE. CARDS ARE 
COPIED VERBATIM ON OUTPUT TAPE ITPCPY UNLESS ITPCPY * 0 . TEMPORARY 
SPACEU...11Q) NEEDED. X1NAME GIVES HOLLERITH NAME FOR STORAGE 
LOCATION XI, ETC. RDATA SCANS A CARD FOR A HOLLERITH NAME WHICH IT 
MATCHES WITH THE XNAME5. WHEN XNNAME IS FOUND, IT STORES THAT DATA 
FOLLOWING XNNAME ON THE CARD IN THE XN VECTOR. THE DATA MAY BE IN 
4 FORMS. (1) AN INDEX VALUE IN, ENCLOSED IN PARENTHESES, 
INDICATING THE POSITION XN( IN) THAT THE NEXT WORD IS TO BE STORED IN. 
IF NO INDEX IS GIVEN ONE IS ASSUMED. (2) FIXED OR FLOATING NUMBERS 

(CONTINUED NEXT PAGE) 
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* ROATA TO REVER * 
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THAT ARE INTERPRETED IN G FORMAT. (3) 12 OCTAL DIGITS FOLLOWED BY 
AN •O 1 THAT ARE INTERPRETED IN 012 FORMAT* OR (4) N HOLLERITH 
CHARACTERS PRECEDED BY •NH 1 . ANY NUMBER OF FIELDS MAY BE PLACED ON A 
CARD. RDATA CONTINUES READING CARDS UNTIL IT ENCOUNTERS THE WORD 
• RETURN* • IANS*G IF ALL OK, *-l IF CALLED WITH THE WRONG NUMBER OF 
ARGUMENTS, » A POSITIVE COUNT OF UN INTERPRET ABLE FIELDS IF THESE ARE 
ENCOUNTERED. 

REFIT (X,LX, TYPE, SYM, ANT I FAP, SECONDARY ENTRY TO SPLIT 

GIVEN SYMU...LSI AND ANTU...LA) WHERE LS*LA*LX AND, IF LX ODD 
LSMLX+U/2 LA=(LX-l)/2, OR IF LX EVEN LS*LA*LX/2, REFIT SETS 
XU...LX), WHERE IF LX ODD XC 1 1-( SYMCLS+1-I l-ANT (LS-I I I /2 FOR 
I*i...LS-l, XUSI=SYMCn, Xm*<$YM(I-LA)+ANTU-LA-l>)/2 FOR 
1=LS+1...LX, AND WHERE IF LX EVEN X ( I I * tSYM (LS+l-I) -ANT CLS+1- I )) /2 FOR 
1*1. ..LS AND XUIMSYMC I-LS ) +ANTU-LS I) /2 FOR I*LS+1...LX. TYPE « 0.0 
SIGNIFIES SYM, ANT AS FXD.PT. AND NOT * 0. SIGNIFIES FLTG.PT. (X WILL BE 
SAME MODEL LX SHOULD EXCEED 0 . EQUIV(SYM,X| OK ONLY IF ALSO HAVE 
EQUIV(ANT,X(LS + 1U. 

REFLEC (X,LX,XMIROR,XIMAGEI FAP, 28 REGISTERS 

OTHER ENTRY - XRFLEC. NO TRANSFER VECTOR. 
SETS XIMAGE(1...LX)*XMIR0R-X(1...LX). EQUI V< XIMAGE ♦ X ) AND CXMIROR, 
ANY X(IM OK, BUT INPUT XMIROR VALUE ALWAYS USED IN SUBTRACTION. 
STRAIGHT RETURN IF LX LSTHN 1. 

RE I M (AMP,PHZ,LR,RE,XIM) FAP, SECONDARY ENTRY TO AMPHZ 

SETS REU...LR) AND XIMU...LR) WHERE RE ( J >*AMP ( J >*COS (PHZ (J ) I AND 
XIM( J)*AMP( J)»SIN<PHZ( Jll. LR MUST EXCEED 0 . PHZ IS IN RADIANS. 

REMAV ( X , LX , X AVG t XNULD ) FAP, 36 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XAVG « (1/LX)*(SUM(FR0M 1*1 TO LXI OF XUII, AND 
XNULD(I) * X<I)-XAVG FOR 1*1. ..LX. EQUI VC X, XNULD ) OK. 
STRAIGHT RETURN IF LX LSTHN 1. 

REREAD FAP, 114 REGISTERS 

OTHER ENTRIES - EOFSET, ENDF IL, ( TSH ) , i TSHM ) . TRANSFER VECTOR - 
(IOH),(RDS),(RDC),(RCH),lTCO),<TEF) ,EXIT,CRER). 
CAUSES THE NEXT • READ INPUT TAPE* STATEMENT TO REINTERPRET THE LAST 
CARD READ. SUCH STATEMENTS SHOULD INTERPRET ONLY ONE CARD. 

RETURN (LOCALL, XR1,XR2) FAP, SECONDARY ENTRY TO LOCATE 

RETURN SENDS CONTROL TO THE FORTRAN STATEMENT JUST FOLLOWING THE FORTRAN 
CALL STATEMENT WHOSE MACHINE ADDRESS IS LOCALL, AFTER RESTORING INDEX 
REGISTERS 1 AND 2 FROM XR1 AND XR2 . LOCALL, XR1 AND XR2 SHOULD 
HAVE BEEN SET UP FROM A PRIOR CALL SETUP STATEMENT. 

REVER (X,LX,XREVD) FAP, 30 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XREVDC 1 . . .LX )=X< LX. . . 1 ) EQUI V { XRE VD, X I OK. STRAIGHT RETURN IF 
LX LSTHN 1 . XII) IS ANY MODE. 
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REVERS (LX,X) FAP, 29 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XU...LX) * X(LX...l) WHERE X IS ANY MODE AND LX MUST 
EXCEED 0 . 



RLSPR ( 1 1 A f R f ALPHA ) FORTRAN, 142 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - FDOTR. 
SOLVES THE EQUATION SUM (FROM 1=1 TO L) OF A ( L- I *1 ) *R ( I- J+i ) * 0. 
FOR J*1...L GIVEN THE SOLUTION SUM (FROM 1*1 TO LI) OF 
A(L-I)*R(I-J*1) * 0. FOR J*1...L1 . LI * L-l IS THE VALUE OF L 
ON INPUT. L IS THEN BUMPED UP BY 1 ON RETURN. RU...LI IS ONE 
SIDE OF AN AUTOCORRELATION VECTOR (R(l) IS CENTER TERM ) • ALPHA * 
SUM (FROM 1 = 1 TO L) OF A(I)*R(I). L MUST BE GRTHN* 0 ON INPUT. 



RLSPR2 ( NRAt NCAT t NCANt AA t NRRt NCRt RR,CC, I ANS ) FORTRAN, 700 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - IXCARG,STZ,M0VREV,DGTP,MATML3, 
DOTJ,SIMEQ. 

SETS AA(1...NRA*NCAT*NRA) = A( 1. . .NRA,1. . .NCAT,1. ..NRA) WHERE 
SUM (FROM 1*1 TO NRA I OF SUM (FROM J=0 TO NCAN+li OF 
ACIt J,KI*R( I-M, J+N-l)) * 0. FOR K*1...NRA, M*1...NRA, 
N*1...NCAN*1 . SETS CC ( 1. • .NRA*NRA ) * C ( 1. . .NRA, 1. . .NRA) INVERSE, 
WHERE C(L,K) * SUM (FROM 1*1 TO NRA) OF SUM (FROM J=0 TO 
NCAN) OF (A(I,J,K)»R(I-L,LM, GIVEN THE A AND C ARRAYS FROM THE 
LAST CALL OF RLSPR2. IT IS SELF-INITIATING IF NCAN*0, THEN EACH CALL 
BUMPS NCAN UP ONE. RR( 1. • .NRR*NCR ) * RC-NRR/2. . .NRR/2,0. ..NCR-1 ) 
IS AN AUTOCORRELATION ARRAY. CC ( I . . .2*NRA*NRA+NRA ) IS COMPUTATION 
SPACE. IANS*0 NORMALLY, =1 IF NCAN GRTHN NCAT, =2 IF NCAN 
LSTHN 0, =3 IF OVERFLOW OCCURS WHILE INVERTING A MATRIX. 



n r « *- ; rui\ir\»N, KCOliltKb 

NO OTHER ENTRIES. TRANSFER VECTOR - FDOTR. 
SOLVES THE EQUATION SUM (FROM 1=1 TO L) OF F (L-I+l )*R( I- J+l) = 
G(L-J*1) FOR J*i...L GIVEN THE SOLUTION OF SUM (FROM 1*1 TO L-l) 
OF F(L-I)*R( I-J + l) * G(L-J) FOR J*1...L-1, AND AU...L) ANO 
ALPHA AS GIVEN BY RLSPR. 



RMSDAV (X,LX,XAVG,RMSXMA) FAP, SECONDARY ENTRY OF RMSDEV 

SETS XAVG * (SUM (FROM 1*1 TO LS) OF X(I))/LX AND RMSXMA * 
SQUARE ROOTUSUM (FROM 1*1 TO LX) OF ( X ( I l-XAVG I SQUARED I /LX I , BUT 
STRAIGHT RETURN WITH NO OUTPUT IF LX LSTHN 1 . 



RMSDEV (X,LX, XBASE, RMSXMB) FAP, 50 REGISTERS 

OTHER ENTRY - RMSDAV. TRANSFER VECTOR - SQRT. 
SETS RMSXMB * SQUARE ROOTUSUM (FROM 1*1 TO LX) OF 

(X(I)-XBASE)SQUARED)/LX), EXCEPT STRAIGHT RETURN WITH NO OUTPUT IF LX 
LXTHN 1 . 



RND F(Y) FAP, 15 REGISTERS 

OTHER ENTRIES - RNDUP,RNDDN. NO TRANSFER VECTOR. 
FUNCTION WHICH ROUNDS Y TO NEAREST FLOATING POINT INTEGER. 
ROUNDING IS UP IF FRACTIONAL PART GRTHN* .500000000, DOWN OTHERWISE. 
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RNDDN F(Y) FAP, SECONDARY ENTRY OF RND 

FUNCTION WHICH ROUNDS Y DOWN TO GREATEST FLOATING POINT INTEGER 
WHICH IS LSTHN- Y . 

RNDUP F(Y) FAP* SECONDARY ENTRY OF RND 

FUNCTION WHICH ROUNDS Y UP TO SMALLEST FLOATING POINT INTEGER 
WHICH IS GRTHN« Y . 

RNDV (X,LX,XR) FAP, 34 REGISTERS 

OTHER ENTRIES - RNDVDN,RNDVUP. TRANSFER VECTOR - RND, RNDUP § RNDDN* 
SETS XR(i...LX)=X(l...LX) ROUNDED TO NEAREST FLTG. PT. INTEGER IROUNDS 
UP FOR FRACTION * 0.5) • EQUIV(X,RX) OK. STRAIGHT RETURN IF LX LSTHN 1. 

RNDVDN (X,LX,XR) FAP, SECONDARY ENTRY OF RNCV 

SETS XR(1...LX)=X(1...LX) ROUNDED DOWN TO NEAREST FLTG. PT. INTEGER 
(I.E., 1.7 GOES TO 1.0, -1.7 TO -1.0). EQUIV(XR,X) OK. STRAIGHT 
RETURN IF LX LSTHN 1. 

RNDVUP (X,LX,XR) FAP, SECONDARY ENTRY OF RNCV 

SETS XR(1...LX),X(1...LX) ROUNDED UP TO NEAREST FLTG. PT. INTEGER 
(I.E., 1.0 GOES TO 1.0, 1.1 TO 2.0, -1.1 TO -2.01. EQUIV(XR,XI OK. 
STRAIGHT RETURN IF LX LSTHN 1. 

R0AR2 ( J08,XA,N,M,XRA) FORTRAN, 174 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - MATRA, MGVREV ,REVERS. 
SETS XRAU.««(M*M+lt«fN*l-») » X (-M. . . M, 0. . . Nl GIVEN 
XA(l...(N+N+l)*(M+i) ) * X(-N...N,O...M) UNDER THE ASSUMPTION THAT 
X IS CENTRO-SYMMETRIC IF J0B=1, OR CENTRO-ANT I SYMMETR IC IF JCB=-1 . 
EQUIVALENCE (XA,XRA) ALLOWED. 

R0TAT1 (X,NX,NUP,ROTX) FAP, 46 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS R0TX(1...NX) WHERE ROTXC I ) S X ( C I-NUP) MODULO NXI, WHERE NX 
EXCEEDS 0, NUP IS ARBITRARY, AND X(l...NX) CAN BE ANY MODE. 
EQUIV(X,ROTX) IS OK. 

RPLFMT ( FMT, FMTNEW ) FAP, 17 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SOMEWHERE FOLLOWING CALL RPLFMT THERE MUST APPEAR AN INPUT OR OUTPUT 
STATEMENT USING THE FORMAT FMT. THIS STATEMENT IS FOUND AND THE FORMAT 
FMTNEW SUBSTITUTED FOR FMT. 

RSKIP ( NT APE , NRECS , EOF ) FAP, 37 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - t ICS) , < TRC ) , ( TCO ) , (TEF ) , CRDS ) , 
( BSR ) • 

SKIPS NRECS PHYSICAL RECORDS FORWARD ON LOGICAL TAPE NTAPE 
(BACKWARDS IF NRECS NEGATIVE AND NO ACTION IF NRECS = 0). SET EOF * 
0.0 NORMALLY BUT = 1.0 IF FOUND END-OF-FILE IN SKIPPING FORWARD 
(NO CHECK FOR END-OF-FILE MADE FOR BACKSKI PP ING) . 

RVPRTS ( SYM, ANT,N) FAP, SECONDARY ENTRY OF CMPRTS 

SETS SYMC1...LS) * SYMUS...1) AND ANTC1...LA) * ANTCLA...1) 
WHERE LS=LA=N/2 IF N EVEN, LS*(N*l)/2 LA*(N-l*/2 IF N ODD. 
N MUST EXCEED 0 . MODES OF SYM AND ANT ARBITRARY. 
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SAME FCIXl) FAP, 1 REGISTER 

OTHER ENTRY - XSAME. NO TRANSFER VECTOR. 
FUNCTION OOES NOTHING BUT SUPPLY FLOATING POINT LABEL FOR ITS 
ARGUMENT WHICH IS ANY MODE. 



SCPSCL (SPACE, NOPTP,YTOP,YBOT,CONVK,CONVL) FAP, 33 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
(SPECIAL SUBROUTINE OF GRAPH. I SETS SPACE C 1. . .NOPTS ) AS FORTRAN 
INTEGERS WHERE SPACE(I) * XFIXF(CONVK+CGNVL*X{ 1 1 I WHERE XCII * 
MAX1F(MIN1F(SPACE( I ) , YTOP ) , YBOT ) , AND WHERE NOPTP EXCEEDS 0, 
YTOP EXCEEDS YBOT. 



SEARCH (LV,VECTOR,XNUM, INDEX) FAP, 25 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SEARCHES VECTORU...LV) LOOKING FOR ELEMENT IDENTICALLY * XNUM. 
IF ANY EXIST SETS INDEX * LOWEST VALUE FOR WHICH VECTOR ( INDEX ) * XNUM. 
IF NOT SETS INDEX * 0 . MODES OF VECTOR, XNUM ARBITRARY. LV MUST 
EXCEED 0 (IF * 0 INDEX IS SET » 0). 



SEQSAC ( ARGLO, ARGDEL ) FAP # 94 REGISTERS 

OTHER ENTRIES - NEXCOS,NEXSIN. TRANSFER VECTOR - COS, SIN. 
NO VISIBLE OUTPUTS. SETS ENTRIES NEXCOS AND NEXSIN SO THAT THEIR 
OUTPUTS ON SUBSEQUENT USES WILL BE FOR ARGUMENT VALUES INCREMENTED BY 
ARGDEL WHERE ARGLO AND ARGDEL ARE IN RADIANS. 

SETAPTF( X, XNEW,FVALUE ) FAP, SECONDARY ENTRY OF INDEX 

PUTS XNEW IN MACHINE LOCATION CONTAINING X, THEN SETS ACCUMULATOR 
EQUAL FVALUE. MODES IMMATERIAL BUT VALUE MISNAMED IF FVALUE IS 
FIXED POINT. 

SETESTF(X,XNEW,XCRTCL) FAP, SECONDARY ENTRY OF INDEX 

PUTS XNEW IN MACHINE LOCATION CONTAINING X, THEN SETS ACCUMULATOR * 
-1.0 IF XNEW LSTHN XCRTCL, » 0.0 IF XNEW « XCRTCL, * +1.0 
IF XNEW GRTHN XCRTCL, WHERE MODE OF ARGUMENTS IMMATERIAL AND WHERE 
PLUS AND MINUS ZERO TREATED AS EQUAL. 

SETINO ( ITAPE,ZIFNEW,NRECS,ERR) FORTRAN, 84 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - XL IMIT,FSKIP, (RWT) , ( TS8) , 
(RLR). 

SETS NRECS'O AND REW INDS LOGICAL TAPE I TAPE. THEN RETURNS IF 
ZIFNEW=0.0 . IF ZIFNEW NOT= 0.0 ASSUMES TAPE CONTAINS INDATA-CUDATA 
FORMAT RECORDS AND USES INDATA TO SPACE TO THE ZERO RECORD NUMBER 
RECORD, LEAVING TAPE POSITIONED TO REWRITE THAT RECORD AND SETTING 
NRECS = RECORD COUNT PRIOR TO THAT RECORD. SETS ERR=7.0 IF ITAPE 
NOT IN CLOSED RANGE 1...20 AND INDATA SETS ERR S 1. 0,2.0, • • • , 6.0 IF 
OTHER TROUBLE. 

SETK (C,X1,X2,...,XN) FAP, 37 REGISTERS 

OTHER ENTRIES - SETKS, SETVEC. NO TRANSFER VECTOR. 
SETS XI » X2 * ... = XN = C WHERE C IS ANY MODE. N MUST EXCEED 0 . 

SETK (C,X1,X2,...,XN) - II FORTRAN, 63 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - SETUP, STORE, RETURN. 
SAME FUNCTION AS FAP VERSION OF SETK. 
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SETKP (Cl,Xll,X12t...tXlNl,STOP,C2,X21,X22,..., FAP, 40 REGISTERS 

X2N2, STOP CM, XMl,XM2 f . .. tXMNMI 

OTHER ENTRY - SETVCP. TRANSFER VECTOR - SETK,SETVEC. 
CALL SETKPC ABOVE ARGUMENTS) WHERE STOP * 0CT777777712345 IS EQUIVALENT 
TO 

CALL SETK(Cl,Xll,X12t... f XlNl) 
CALL SETK(C2,X21, X22t • • • tX2N2 ) 
ETC 

CALL SETK(CM, XMi, XM2, . . . , XMNM I . 

SETKS (CI, XI, C2tX2,...,CN,XN) FAP, SECONDARY ENTRY OF SETK 

SETS X1=C1, X2»C2,..., XN*CN IN THAT ORDER. WHERE 
Cl,C2,..., ARE ANY MODES. EQUIV(CM,XLI OK FOR ANY M,L PAIR. 



SETKS (Cl,Xl,C2tX2,... t CN,XN) - II FORTRAN, 91 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - SETUP, ARG, STORE, RETURN. 
SAME FUNCTION AS FAP VERSION OF SETKS 



SETKV (C,LX,X) FAP, 15 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XC1...LXI * C, WHERE C IS ANY MODE. EQUIVtCSOME X ( 1 1 1 OK, 
BUT INITIAL VALUE OF C IS ALWAYS THE QUANTITY STORED. STRAIGHT RETURN 
IF LX LSTHN 1. 



SETKVS (CltLl,Xl,C2,L2,X2,...,CN,LN,XN) FAP, 25 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS Xl(i...Ll)*Cl, X2(l...L2)*C2t ... f XNU.. .LN)»CN IN 
THAT ORDER, WHERE C1,C2,... ARE ANY MODE. IF ANY LX LSTHN* 0, 
CORRESPONDING X NOT MODIFIED. EQUIV (ANY TWO ARGUMENTSI OK. 



SETLIN (BASE, DELTA, LX,X) FAP, 27 REGISTERS 

OTHER ENTRY - XSTLIN. NO TRANSFER VECTOR. 
SETS X(II*BASE*U-1>»DELTA, 1 = 1. ..LX. EQU IV ( BASE , DELTA, ANY X(IH OK, 
INPUT VALUES OF BASE AND DELTA ALWAYS USED. STRAIGHT RETURN IF 
LX LSTHN 1. 



SETLNS ( BASEL , DELTA 1, LX1 , XI, BASE2t DELTA2, FAP, 39 REGISTESR 

LX2,X2,...,BASEN,CELTAN,LXN,XN) 

NO OTHER ENTRIES. TRANSFER VECTOR - SETLIN, XSTLIN. 
CALL SETLNS( ABOVE ARGUMENTS ) IS EQUIVALENT TO 
CALL SETLIN(BASE1,DELTA1,LX1,XU 
CALL SETLIN(BASE2,DELTA2,LX2,X2> 
ETC 

CALL SETL IN( BASEN, DELTAN,LXN, XN ) 
EXCEPT THAT FOR EACH DELTA WHICH, INTERPRETED AS FIXED POINT, IS LSTHN* 
10OOO OR WHICH HAS BIT 9*0 SUBROUTINE XSTLIN IS USED IN PLACE OF 
SETLIN. 



SETSBV (SUBRU,SUBRUV,ARG1,ARG2,...,ARGNI FAP, SECONDARY ENTRY OF LOCATE 

SETS SUBRUVU...N+4) * SUBROUTINE VECTOR AS REQUIRED BY A CALL CALL2 
STATEMENT, WHERE N MAY = 0 . SETS SUBRUVU) * SUBRU * SUBROUTINE 
PROXY NAME, (2) * N, (3) * OCT 777777777777, (4) * IXARGl f ...t (N+3) * 
IXARGN, (N*4I * OCT 777777777777, WHERE IXARG * INDEX WITH RESPECT TO 
COMMON BLOCK OF ARG. SUBRUV IS A MIXED MODE VECTOR AS SHOWN. 
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SETUP (L0CALL,NARGS,XRl,XR2) FAP, SECONDARY ENTRY OF LOCATE 

CALL SETUP IS USED AS FIRST INSTRUCTION OF A SUBROUTINE. SETS LOCALL * 
MACHINE ADDRESS OF CALL STATEMENT CALLING THE SUBROUTINE , SETS 
NARGS = NO* OF ARGUMENTS IN THAT CALL STATEMENT, SETS XR1 AND XR2 
(DECREMENTS I « INDEX REGISTERS 1 AND 2 • 

SETVCP (X1,C11,C12,...,C1N1,ST0P, FAP, SECONDARY ENTRY OF SETKP 

X2,C2l,C22,...,C2N2,STOP, 
....... XM,CM1,CM2,...,CMNM) 

CALL SETVCPCABOVE ARGUMENTS) WHERE STOP * 0CT777777712345 IS EQUIVALENT 
TO 

CALL SETVEC(Xl,Cli,C12,...,ClNl) 
CALL SETVEC(X2,C2l,C22,...,C2N2) 

ETC 

CALL SETVEC ( XM, CM 1 ,CM2 , . . . , CMNM ) . 

SETVEC (X,C1,C2,...,CN) FAP, SECONDARY ENTRY OF SETK 

SETS XU...N) =* C1,C2,...,CN WHERE C1,C2,... ARE ANY MODE* 

SEVRAL (SUBRUA,Al, A2, . . . , ANA, SUBRUB, Bl , B2 , . . . , BNB , FAP, 416 REGISTERS 

,SUBRUZ,ZL,Z2,...,ZNZ) 

OTHER ENTRIES - PLURAL , DO, IF* TRANSFER VECTOR - LOCATE , WHERE. 
THE ABOVE CALL SEVRAL STATEMENT ASSUMES THE SUBROUTINES SUBRA. ..SUBRZ 
WITH PROXY NAMES SU8RUA. . .SUBRUZ HAVE BEEN PREVIOUSLY LOCATED BY A 
CALL LOCATE STATEMENT, IN WHICH THE ARGUMENT LISTS ARE OPTIONAL, BUT IF 
PRESENT MUST BE CORRECT IN NUMBER. THE FUNCTION IS EQUIVALENT TO 

CALL SUBRA(A1,A2,...,ANA) 
CALL SUBRB(B1,B2,...,8NB) 
PTC 

CALL 5UBKH4LL, ,£IN£ I 
NONE OF SUBRA. ..SUBRZ MAY USE DATA BEYOND THE END OF THEIR 
CALLING SEQUENCES. THE PSEUDO ENTRIES DO AND IF MAY BE USED 
AS SUBROUTINES TO BE OPERATED AND DO NOT NEED TO BE LOCATED. PLURAL 
MAY NOT BE OPERATED BY SEVRAL. 

SHFTR1 (NSHFT,IV,LIV,IVSH, IANS) FAP, 70 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS IVSHU... LIV) FROM IVU. ..LIV) WHERE IVSHU) * IVU) SHIFTED 
RIGHT ARITHMETICALLY N BITS (LEFT IF N NEGATIVE, NO SHIFT IF N * 0) 
WHERE N * NSHFT (MODULO 36). SETS IANS * 0 IF ALL OK, » U IF 
OVERFLOW (ON NEG NSHFT, BUT SHIFTING COMPLETED), * -3 IF LIV 
LSTHN I . EQUIV(IVSH,IV) OK. 

SHFTR2 (NSHFT, IV,LIV,IVSH, IANS) FAP, 72 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS IVSHU...LIV) FROM IVU. ..LIV) WHERE IVSH(I) » IVU) 
SHIFTED RIGHT LOGICALLY N BITS (LEFT IF N NEGATIVE, NO SHIFT IF 
N » 0) WHERE N » NSHFT (MODULO 36). SETS IANS * 0 IF ALL OK, 
= U IF OVERFLOW (ON NEG NSHFT, BUT SHIFTING COMPLETED), « -3 
IF LIV LSTHN 1 . EQUIVU VSH, IV) OK. 



SHUFFL ( ITPRD,NITEMS, ISPACE, IXSHUF) 

NO OTHER ENTRIES. TRANSFER VECTOR 



FORTRAN, 1C1 REGISTERS 
- GETRD1, SEARCH, SIZEUP. 

(CONTINUED NEXT PAGE* 



••*»•*•*** »•*#*»» »»»•»*• 

* SHUFFL TO SIZEUP » 
**•*•»*»****•»»»»*•»•#•• 



PROGRAM DIGESTS 



•*•*•*»«•**••»•••»*•**•* 

» SHUFFL TO SIZEUP * 
*•*»»••••••••**•«*•«••«* 



SETS IXSHUFC1...NITEMSI AS A RANDOM ORDERING OF THE INTEGERS 
I...NITEMS INDEPENDENT FROM PREVIOUS ORDERINGS, IF ANY, FORMED BY 
PRIOR CALLS OF SHUFFL WITHIN THE PRESENT EXECUTION* ASSUMES LOGICAL 
TAPE ITPRD CONTAINS RAND RANDOM DIGITS BCD CARDS* USES 5»NITEMS 
NEW RANDOM DIGITS FOR EACH CALL (SUPPLIED BY GETRDU, AND NEVER 
REWINDS ITPRD. NEEDS I SPACE C 1 .. .N ITEMS ) FOR SCRATCH. DOES NOT CHECK 
LEGALITY OF ITPRD BUT GIVES STRAIGHT RETURN WITH NO OUTPUT IF NITEMS 
LSTHN 1 . 

SIFT CX,MESH»LXSFTD,XSFTD) FAP, 30 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XSFTDC 1...LXSFTD) = X ( 1 , 1+MESH, 1+2»MESH, . . . , 1+ ( LXSFTD-i ) *MESH ) 
WHERE X IS ANY MODE. REQUIRE LXSFTD GRTHN* 1, MESH GRTHN* 0 . 
STRAIGHT RETURN WITH NO OUTPUT IF EITHER ILLEGAL. EQUI V ( X , XSFTD I OK. 

SIMEQ (Nt LN,LM, A, B,D, E, ERR) FAP, 441 REGISTERS 

OTHER ENTRY - DETRM. NO TRANSFER VECTOR. 
SOLVES MATRIX EQUATION AX=8 FOR X, WHERE AC 1. . .LN , 1. . .LN) IS 
DIMENSIONED A (N, ARBITRARY) WITH LN LSTHN* N, B ( 1 . . . LN , 1 . . .LM) 
IS DIMENSIONED B(N,N1) WITH LM LSTHN* Nl LSTHN* N BUT LM MAY 
EXCEED LN, AND THE OUTPUT X ( 1. • .LN, 1. • • LM! HAS SAME DIMENSIONS AS B 
BUT REPLACES THE A MATRIX. D ON INPUT IS SCALE TO MULTIPLY 
DETERMINANT BY, ON OUTPUT D * SCALED VERSION OF DETERMINANT OF A 
(WILL * 0. IF A SINGULAR). B IS DESTROYED. EU...LN) MUST BE 
AVAILABLE FOR SCRATCH. SETS ERR * 0. IF ALL OK, * 1. IF UNDERFLOW 
OR OVERFLOW, * 2. IF A IS SINGULAR. 

SINTBL (N, SINTAB) FAP, SECONDARY ENTRY OF COSTBL 

SETS SINTABC1...N+1) = SC0...N) WHERE SCI) * SINCI«PI/NI. STRAIGHT 
RETURN IF N LSTHN* C . 

SINTBX (NtlSINTB) FAP, SECONDARY ENTRY OF COSTBL 

SETS ISINTBU...N + 1I * IS<O...N) WHERE ISf 1 1 * SINCI«PI/NI AND IS 

FXD.PT. WITH BINARY PT. BETWEEN SIGN AND BIT 1 AND 1.0 IS 

SET * OCT 377777777777. STRAIGHT RETURN IF N LSTHN* 0 . 

SISP ( SAX, A AX, L, SINTAB, M, FAP, SECONDARY ENTRY OF COSP 

JMIN, JMAX, TYPE, S INTR ) 
SETS SINTR( 1...JMAX-JMIN+1) * ST( JMIN.. .JMAX) WHERE ST(J) * SUM 
(FROM I * 0 TO L) OF ( X ( I ) *S INC I*J*P I/M) I , WHERE XCO...L) * 
SAXC1...L+1) FOR J ODD, * AAXU...L+1I FOR J EVEN, GIVEN THE 
TABLE SINTABC1...M+1) * SCO...M) WITH SCI) * SINCI*PI/M). TYPE *0.0 
SPECIFIES SAX, AAX, AND COSTAB TO BE FXD.PT., TYPE NOT * 0.0 DESIGNATES 
EVERYTHING FLTG.PT. EQUI V( SAX, AAX ) OK. IF M NEGATIVE, ITS MAGNITUDE 
IS USED AND STC.) IS ADDED INTO SINTRC.) RATHER THAN STORED INTO IT. 
STRAIGHT RETURN IF L LSTHN* 0, OR M*0, OR JMIN LSTHN* 0, OR JMAX LSTHN* 
JMIN OR GRTHN M. 

SIZEUP CX,LX, INDEX) FAP, 136 REGISTERS 

OTHER ENTRY - SIZUPL. NO TRANSFER VECTOR. 
SETS INDEX! 1...LX) FROM XC1...LX) SUCH THAT XC INDEXC 1+1 ) ) IS 
ALGEBRAICALLY GRTHN* XCINDEXCI)) WHERE X IS ANY MODE. STRAIGHT 
RETURN IF LX LSTHN 1 . EQUAL VALUES OF X ARE NOT NECESSARILY IN 
THE SAME ORDER AS THEY OCCURRED IN X. 



*•»•****#»**•••»•*»*»**« 
* SIZUPL TO SQRDFR * 
»•***»••»*•»•*•»»•«*••*« 



PROGRAM DIGESTS 



**»•••* *«**»•»*«•*•«••»• 

» SIZUPL TO SQRDFR * 
*»•»**•*»•**••*«•«*••*»• 



SIZUPL (X,LX, INDEX) FAP, SECONDARY ENTRY OF SIZEUP 

SETS INDEXQ...LX) FROM XU...LX) SUCH THAT X{ INDEX ( 1*1 ) ) IS 
LOGICALLY GRTHN* X(INDEXU)) WHERE X IS ANY MODE* STRAIGHT RETURN 
IF LX LSTHN I . EQUAL VALUES OF X ARE NOT NECESSARILY IN THE 
SAME ORDER AS THEY OCCURRED IN X. 

SMPRDV (X,LX,N, XBASE, SXMB2N) FAP, SECONDARY ENTRY OF POKER 

SETS SXMB2N * SUM (FROM 1*1 TO LX) OF {XC D-XBASE )»*N, WHERE 
N IS ARBITRARY. STRAIGHT RETURN IF LX LSTHN 1. 

SMPSON ( JOBf XtLXt DELXfXINTt IANS) FORTRAN, 317 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
FOR JOB=0 SETS XINT * SIMPSON'S RULE INTEGRAL OF XU...LX! WITH 
INCREMENT DELX, TRAPEZOIDAL RULE BEING USED BETWEEN X(LX-l) AND 
XCLX) IF LX IS EVEN. FOR JOB GRTHN 0 OOES SAME AS JOB*0 BUT 
LEAVES XU...LX) SCALED BY WEIGHTING COEFFICIENTS DELX»( 1/3,4/3,2/3, 
4/3, ...,4/3, 1/31 IF LX ODD OR 8Y DELXM 1/3,4/3,2/3,. ..,4/3,5/6,1/21 
IF LX EVEN. FOR JOB LSTHN 0 MERELY REMOVES ABOVE SCALING FROM 
XU...LX). REQUIRE DELX NOT* 0.0 (NOT CHECKED) AND LX GRTHN* 3 
(STRAIGHT RETURN WITH NO OUTPUT IF ILLEGAL). 

SPC0R2 (NRX,NCX,XX,NRY,NCY,YY,MXACC,ILGR, FORTRAN, 291 REGISTERS 

NRZ,ILGC, INC, NCZ,ZZ, SPACE, IANS) 

NO OTHER ENTRIES. TRANSFER VECTOR - XLOC ,STZ,FXDATA,QXC0R1 ,FLDATA. 
SETS ZZ (l...NRZ»NCZ I * Z( ILGR. . . ILGR+NRZ-1, ILGC. . . ILGC+NCZ-1) WHERE 
Z(I,J) * SUM (FROM K*l TO NCX) OF SUM (FROM L*l TG NRX) OF 
(X(K+I-1,L*J1)*Y(K,L) WHERE Jl * ILGC, ILGC + INC , . . . , I LGC* (NCZ-1 ) * INC , 
AND X(1...NRX,1...NCX) * XX ( 1 . . .NRX*NCX) , Y( 1 . . . NRY, 1 . . . NC Y) * 

YY(1 NRY#NCY ) - COMPUTATIONS ARE APPROXIMATE. XX AND YY ARE 

LUNVfcKI fcU IU lNltbtK 5tyUtNLI:5 Willi PI A A i HUP! flAbNilUUC * PIA«^U 

(1 TO 1000) DURING COMPUTATIONS, BUT ARE REFLOATED AFTERWARDS. 
SPACE(1...MIN(NRX,NRY)+10»(MXACC+1)+1) USED FOR SCRATCH. SETS IANS 
* 0 IF ALL OK, * ARGUMENT NUMBER IF ONE IS ILLEGAL. 

SPLIT (X,LX, TYPE, SYM, ANT) FAP, 224 REGISTERS 

OTHER ENTRY - REFIT. NO TRANSFER VECTOR. 
SETS SYMU...LS) AND ANTU...LAI FROM X(1...LX), WHERE LS * LA * 
LX/2 FOR LX EVEN, LS * (LX+D/2 AND LA * (LX-D/2 FOR LX ODD, AND WHERE 
FOR LX EVEN SYM(I) « X (LS+I ) +X CLS+i-I ) AND ANT(I) * X(LA*I)- 
XUA+l-I), BUT WHERE FOR LX ODD SYM(l) * X(LS) SYM(I) * X(LS-H-I) 
♦XUS+l-I) FOR I * 2...LS AND ANT(I) * X( LS + I )-X (LS-I I . TYPE * 0. 
SIGNIFIES X IS FXD.PT. (SYM AND ANT WILL HAVE SAME BINARY PT.), 
TYPE NOT * 0.0 SIGNIFIES SYM, ANT, X FL TG. PT. ANT IS OUTPUT ONLY IF 
LA GRTHN 0 . STRAIGHT RETURN IF LX LSTHN* 0 . EQUIV(SYM,X) OK ONLY IF 
EQUIV(ANT,X(LS+1) ) ALSO HOLDS. 

SQRDEV (X, XBASE, LX,SSQXMB) FAP, SECONDARY ENTRY OF SQRDFR 

SETS SSQXM8 * SUM (FROM I * 1 TO LX) OF ( X ( I )-XBASE ) SQUARED. 
STRAIGHT RETURN IF LX LSTHN 1. 

SQRDFR (X,Y,LXY,SSQXMY) FAP, 36 REGISTERS 

OTHER ENTRY - SQRDEV. NO TRANSFER VECTOR. 
SETS SSQXMY * SUM (FROM I * 1 TO LX) OF ( X( I )-Y( 1 1 ) SQUARED. 
STRAIGHT RETURN IF LX LSTHN 1. 



*•**«*•••»*****«»******• 
» SQRMLI TO STORE » 
»»*••*•*»**»••»•*•»***»• 



PROGRAM DIGESTS 



»••«*•»••••*••»*• *•«•••* 

» SQRMLI TO STORE » 
««•»*•»••*•»»•»**••««••* 



SQRMLI (MLIVEC,lLO,IHI,MLISQR, IANSI FAP, 55 REGISTERS 

NO OTHER ENTRIES* NO TRANSFER VECTOR. 
SETS MLISQR(1...IHI~ILG*1) * SQUARES OF ML IV EC ( ILO. • • IHI ) 
ASSUMING MLIVEC ARE MACHINE LANGUAGE INTEGERS, WHERE 1 LSTHN* ILO 
LSTHN= IHI. SETS IANS * 0 IF ALL OK» = -1 IF ILLEGAL ILO OR IHI, 
= -2 IF ONE OF THE SQUARES OVERFLOWS (IMMEDIATE RETURN IN THIS CASE). 



SQROOT (XtLXtXSQRTD) FAP f 24 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - SQRT. 
SETS XSQRTDU...LX) = SQUARE ROOT ( MAGNITUDE ( X( 1.. .LX) ) ). 
EQUIV(XSQRTD,X) OK. STRAIGHT RETURN IF LX LSTHN 1. 

SQRSUM (X,LX,SUMSQX> FAP, 36 REGISTERS 

OTHER ENTRY - XSQSUM. NO TRANSFER VECTOR. 
SETS SUMSQX = SUM (FROM I = 1 TO LX) OF X(I)»X(I). STRAIGHT RETURN 
IF LX LSTHN 1 . 



SQUARE (X,LX,XSQRD) FAP, 32 REGISTERS 

OTHER ENTRY - XSQUAR. NO TRANSFER VECTOR 
SETS XSQRDU...LX) * XU...LX) SQUARED. EQUI V( X,XSQRD) OK. STRAIGHT 
RETURN IF LX LSTHN 1. 

SRCH1 ( JOB, LV,V, VALUE, INDEX) FORTRAN, 93 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - XACTEQ. 
SEARCHES VU...LVI FOR VALUE SO THAT VALUE = V(INDEX). 
IF JOB = 1 SEARCHING BEGINS AT V(l), IF JOB » 2 SEARCHING 
BEGINS AT V(LV). LV MUST BE GRTHN* 1 . 

STEPC F(ARG) FAP, SECONDARY ENTRY OF DELTA 

HAS VALUE 1.0 OR 0.0 ACCORDING AS SIGN BIT OF ARG IS PLUS OR 
MINUS. 



STEPL F(ARG) FAP, SECONDARY ENTRY OF DELTA 

HAS VALUE 1.0 IF ARG (ANY MODE) HAS VALUE GRTHN* MINUS ZERO. 

OTHERWISE HAS VALUE = 0.0 . 

STEPR F(ARG) FAP, SECONDARY ENTRY OF DELTA 

HAS VALUE = 1.0 IF ARG (ANY MODE) EXCEEDS ZERO. 

OTHERWISE HAS VALUE = 0.0 . 

(STH) FAP, SECONDARY ENTRY OF GNLINE 

SERVES SAME FUNCTION AS STANDARD FORTRAN (STH) SUBROUTINE. 



(STHD) FAP, SECONDARY ENTRY OF ONLINE 

SERVES SAME FUNCTION AS STANDARD FORTRAN (STHD) SUBROUTINE. 

( STHM) FAP, SECONDARY ENTRY OF ONLINE 

SERVES SAME FUNCTION AS STANDARD FORTRAN (STHM) SUBROUTINE. 



STORE ( ARGU, LOCAL L,NUM ARG, IXVECT) FAP, SECONDARY ENTRY OF LOCATE 

STORES THE VALUE ARGU (ANY MODE) AS ELEMENT NO. IXVECT OF THE VECTOR 
WHICH IS ARGUMENT NC . NUMARG OF THE CALL STATEMENT AT MACHINE ADDRESS 
LOCALL. LOCALL SHOULD BE NON-NEG, NUMARG MUST EXCEED 0 BUT IXVECT 
IS UNRESTRAINED. 



•»•••»*•»»»•••»••»•»»••« PROGRAM DIGESTS ##*#•##*»*»**»»*»•#*«**»# 

• STZ TO TAMVR « • STZ TO TAMVR * 

»*»•***••*•***«••»••**•* *••**•»•*•*•••»•••*••**• 



STZ UX,X) FAPt 14 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XU...LX) » ZERO, WHERE X IS ANY MODE. STRAIGHT RETURN IF 
LX LSTHN 1. 

STZS (LX1,X1,LX2,X2,...,LXN,XN) FAPt 24 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS ALL ELEMENTS OF THE VECTORS XU 1. . .LXI) ,X2( 1...LX2I »... ,XN< 1...LXNI 
EQUAL ZERO (MODE ARBITRARY I, EXCEPT BYPASSES EACH VECTOR X 
FOR WHICH LX LSTHN 1. N SHOULD EXCEED ZERO. 

SUBK (CfXl,X2i...f XNI FAP, SECONDARY ENTRY OF AOCK 

SETS X1=X1-C, X2=X2-C, XN-XN-C. EQUI V C ANY ARGUMENTS I CK, 

BUT INITIAL VALUE OF C IS ALWAYS THE SUBTRAHEND. STRAIGHT RETURN IF 
N=0. 

SUBKS <Cl,Xl,Yl t C2,X2,Y2, . . . ,CN,XN, YN) FAP, SECONDARY ENTRY OF AOCK 

SETS Y1=X1-C1, Y2=X2-C2, YN=XN-CN. EQUIVUNY TWO ARGUMENTS) 

OK BUT MAY CHANGE INPUTS CJ OR XJ. PROCESSING IS LEFT TO RIGHT. 
STRAIGHT RETURN IF N»0. 

SUM (X,LX,SUMX) FAP, 23 REGISTERS 

OTHER ENTRY - XSUM. NO TRANSFER VECTOR. 
SETS SUMX ■ SUM (FROM 1= 1 TO LXI OF XCII. STRAIGHT RETURN 
IF LX LSTHN 1. 

SUMDEV (X, XBASE, LX,SUMXMB) FAP, SECONDARY ENTRY OF SUMDFR 

SETS SUMXMB « SUM (FROM I « 1 TO LX) OF ( X ( I l-XBASE ) . STRAIGHT RETURN 
IF LX LSTHN 1. 

SUMDFR (X,Y,LXY,SUMXMY) FAP, 44 REGISTERS 

OTHER ENTRIES - XSMDFR, SUMDEV, XSMDEV. NO TRANSFER VECTOR. 
SETS SUMXMY * SUM (FROM I = i TO LX) OF (X(I)-Y(I)). STRAIGHT RETURN 
IF LX LSTHN 1. 

SWITCHF(ISENSE) FAP, 15 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
HAS VALUE * 1.0 IF SIMULTANEOUSLY ISENSE IS IN THE CLOSED RANGE 
1...6 AND THE CORRESPONDING SENSE SWITCH IS DEPRESSED (CN). OTHERWISE 
HAS VALUE » 0.0 . 

TAMVL (X,LX,LAVG,AVGL) FAP, 63 REGISTERS 

OTHER ENTRY - TAMVR. NO TRANSFER VECTOR. 
SETS AVGL(I) = f 1/tLX-I+ll I * (SUM (FROM J=I TO LXI OF X(J) ) 
FOR I=1...LAVG. STRAIGHT RETURN WITH NO OUTPUT IF LX OR LAVG 
LSTHN 1, OR IF LAVG GRTHN LX. 

TAMVR (X,LX,LAVG,AVGR) FAP, SECONDARY ENTRY OF TAMVL 

SETS AVGR(I) * Cl/UX-I + m • (SUM (FROM J = I TO LX-I+1) OF X(J) ) 

FOR 1*1. ..LAVG. STRAIGHT RETURN WITH NO OUTPUT IF LX GR LAVG 

LSTHN 1, OR IF LAVG GRTHN LX. 



•*»••• »••*•»»•••**••«•»» 



PROGRAM DIGESTS 
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* TIMA2B TO UNPAKN » 



» TIMA2B TO LINPAKN * 



**••»»*»»**»»»*»••»*»•»* 



*»•«••••*•••»••«••••**»• 



TIMA2B (LOCA,LOCB, MINACC, SECS) 



FAP (7094), 124 REGISTERS 



NO OTHER ENTRIES. NO TRANSFER VECTOR. 
MACHINE ADDRESS LOCA CONTAINS A PROGRAM WHICH WHEN DONE SENDS CONTROL 
TO LOCB AND WHICH MAY BE REPETITIVELY OPERATED. TIMA2B SETS SECS « TIME 
IN SECONDS (TO ACCURACY OF 1 PART IN MINACC PARTS) OF I OPERATION OF THE 
PROGRAM EXCLUDING TIME OF OPERATION AT LOCB. ASSUMES INTERVAL TIMER 
IS ON. 

TIMSUB (MINACC, SECS) FAP, 229 REGISTERS 

OTHER ENTRY - INTMSB. TRANSFER VECTOR - TIMA2B. 
CALL TIMSUB IS IMMEDIATELY FOLLOWED BY CALL SUBRU( A,B, . . . , Zl OR BY AN 
X=SOMEF(...) TYPE STATEMENT WHERE SUBRU OR SOMEF MAY BE OPERATED 
REPETITIVELY. TIMSUB SETS SECS = TIME IN SECONDS (TO AN ACCURACY OF 1 
PART IN MINACC PARTS) THAT ONE OPERATION OF SUBRU OR SOMEF REQUIRES. 
IF SUBRU OR SOMEF MAY NOT BE OPERATED REPETITIVELY WITHOUT REGENERATING 
ITS INPUTS, THE INPUT SETUP SEQUENCE SHOULD IMMEDIATELY PRECEDE THE 
CALL TIMSUB(MINACCSECS) STATEMENT AND IMMEDIATELY PRECEDING THE INPUT 
SETUP SEQUENCE SHOULD APPEAR A CALL INTMSB STATEMENT. ASSUMES INTERVAL 
TIMER IS ON. 

TINGL (YOFX,LY,DELX,TING) FAP, 43 REGISTERS 

OTHER ENTRY - TINGLA. NO TRANSFER VECTOR. 
SETS TING - TRAPEZOIDAL INTEGRAL OF YOFXU...LY) WITH INCREMENT 
DELX (MAY BE NEGATIVE) BUT STRAIGHT RETURN WITH NO OUTPUT IF LY LSTHN 
2 • 

TINGLA ( YOFX,LY,DELX, T INGA ) FAP, SECONDARY ENTRY OF TINGL 

SETS TINGA * TRAPEZOIDAL INTEGRAL OF MAGNITUDES OF YOFX(l...LY) 
WITH INCREMENT DELX BUT STRAIGHT RETURN WITH NO OUTPUT IF LY LSTHN 
2 . TINGA WILL BE NEGATIVE IF DELX IS. 

TRMINO ( I TAPE, NBAKUP ) FORTRAN, 67 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - XLIMIT,OUDATA,FSKIP, (RWT) . 
CREATES, VIA OUDATA, A ZERO RECORD NUMBER DUMMY RECORD ON LOGICAL TAPE 
ITAPE, THEN LEAVES TAPE NBAKUP FILES CLOSER TO LOAD POINT THAN ITS 
POSITION AT INSTANT OF CALL TRMINO STATEMENT, EXCEPT REWINDS IF 
NBAKUP LSTHN 0 . NBAKUP = 0 LEAVES TAPE READY TO READ DUMMY RECORD. 
REQUIRE ITAPE IN CLOSED RANGE 1...20 OTHERWISE STRAIGHT RETURN WITH 
NO OUTPUT. 

(TSH) FAP, SECONDARY ENTRY OF REREAD 

SERVES SAME FUNCTION AS STANDARD FORTRAN (TSH) SUBROUTINE. 

(TSHM) FAP, SECONDARY ENTRY OF REREAD 

SERVES SAME FUNCTION AS STANDARD FORTRAN (TSHM) SUBROUTINE. 

UNPAKN (N,LD,D, SCALE) FAP, 78 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS DU...LD) AS UNPACKED, FLOATED AND RESCALED FORM OF PACKED 
INPUT D(1...(LD+N-1)/N), THE PACKED INPUT HAVING ORIGINALLY BEEN FORMED 
BY A CALL PAKN(N,LD,D, SCALE) STATEMENT. D IS UNCHANGED IF N * 1 . 
UNPAKN IS APPROXIMATE INVERSE TO PAKN. TO RECOVER FXD.PT. INTEGERS 
WHICH WERE FLOATED AND PACKED BY PAKN, USE UNPAKN FOLLOWED BY 
ROUNDING AND FIXING LOOP. 



»*****»••*»»•*»•«••••*»• 

* VARARG TO VPLUSV » 
••**»••*••**••»*•*••*••• 



PROGRAM DIGESTS 



•*•»••*«*»•«»•»•*••«••«» 

* VARARG TO VPLUSV ♦ 
»»*•»••«*••*•••»»••»•**• 



VARARG (LOCS) FAP, 44 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
USED AT VERY BEGINNING OF A VAR I ABLE-LENGTH-CALL I NG- SEQUENCE 
SUBROUTINE AS FOLLOWS - CALL VARARG(LOCS) - GO TO 20 - 10 RETURN - 
WHERE STATEMENT 20 BEGINS THE COMPUTATIONS WHICH TERMINATE WITH A 
GO TO 10 STATEMENT. IN THIS USAGE VARARG SETS LOCS ( 1. . .N+l ) * 
XL0CF(ARG1),...,XL0CF(ARGN), 0 WHERE ARGJ * JTH ARGUMENT OF CALL 
STATEMENT WITH N TOTAL ARGUMENTS, AND MODIFIES RETURN STATEMENT 
AT 10 FOR PROPER LINKAGE. 



VDOTV (X, Y, LXY, DVSR, XDYODV) FAP, 25 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XDYODV * (l/DVSR) « (SUM (1 = 1 TO LXY) OF XCI)*Y(I) I 
PROVIDED DVSR NOT* 0.0 . IF DVSR * 0.0, SETS XDYODV * 1.0 AND 
SETS DVSR = SUM i 1 = 1 TO LXY) OF X(I)»Y(I). STRAIGHT RETURN WITH 
NO OUTPUT IF LXY LSTHN 1 . 



VDVBYV (X,Y,LXY,XDVBYY) FAP, 22 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
SETS XDVBYYU...LXYI FROM XC1...LXY) AND Yd. ..LXY), WHERE 
XDVBYY(I) * X(I)/YCI). EQUI VCXDVBYY, X OR Y) OK. DIVISION BY ZERO 
NOT TESTED FOR BY VDVBYV. STRAIGHT RETURN IF LXY LSTHN 1 . 

VECOUT { ITAPE,FMT, X, ILO, INI ) FORTRAN, 66 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - FNDFMT ,RPLFMT, (STH ) , (F IL ) . 
OUTPUTS THE VECTOR RANGE XULO...IHI) ONTO LOGICAL TAPE ITAPE ACCORDING 
TO FMTCI), WHERE FMT(I) IS A NORMLIT FORMAT VECTOR AS DEFINED ABOVE 
IN CVSOUT. REQUIREMENT THAT 1 LSTHN* ILO LSTHN* IHI NOT CHECKED BY 
VECOUT. 



VINDEXF( I, ICRTCL, IJUMP) FAP, SECONDARY ENTRY OF INDEX 

ADDS I JUMP TO MACHINE LOCATION CONTAINING I, THEN SETS ACCUMULATOR 

* -1.0 IF NEW I LSTHN ICRTCL, * 0.0 IF NEW I * ICRTCL, 

* +1.0 IF NEW I GRTHN ICRTCL, WHERE +0 AND -0 TREATED AS 
EQUAL. 



VMNUSV CX,Y,LXY,XMNUSY) FAP, SECONDARY ENTRY OF VPLUSV 

SETS XMNUSYU...LXY) FROM XC1...LXY) AND YC1...LXY), WHERE 

XMNUSYCI) * XU)-Y(I). EQUIVIXMNUSY, X OR Y) OK. STRAIGHT RETURN 
IF LXY LSTHN 1 . 



VOUT (ITAPE, NSPACE,X,XNAME,XFMT, ILO, IHI) FORTRAN, 104 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - CARI GE ,HRADJ , ( STHI , CFILI , 
VECOUT. 

OUTPUTS VECTOR RANGE X C ILO, . . . , IH I ) ONTO LOGICAL TAPE ITAPE ACCORDING TO 
XFMTU), WHERE XFMT(I) IS A NORMLIT FORMAT VECTOR AS DEFINED IN CVSOUT 
ABOVE, PRECEDED BY 1) NSPACE SPACES (OR A PAGE RESTORE IF NSPACE 
LSTHN 0), AND 2) A HEADING LINE OF FORM XNAME( ILO, ILO+1, .. . , IHI ) * , 
WHERE XNAME IS 6 OR LESS HOLLERITH CHARACTERS. IHI MUST BE GRTHN* ILO. 
(IF =, THE HEADING IS XNAME ( ILO) • ) ILO MUST EXCEED ZERO. 

VPLUSV (X,Y,LXY,XPLUSY) FAP, 34 REGISTERS 

OTHER ENTRIES - XVPLSV, VMNUSV, XVMNSV. NO TRANSFER VECTOR. 
SETS XPLUSYU...LXY) FROM XU...LXY) AND YC1...LXY), WHERE 
XPLUSY(I) * X(I)*Y(I). EQUIVUPLUSY, X OR Y) OK. STRAIGHT RETURN 
IF LXY LSTHN 1 . 



»*•**•»••**»»*••**»•*•*• 

* VRSOUT TO WLLSFP • 
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PROGRAM DIGESTS 



* VRSOUT TO WLLSFP ♦ 
••»•»••••*»•»•»••*•••••• 



VRSOUT (ITAPE, NSPACE, FMT, SPACE, XI, X2,...,XN) FAP, 47 REGISTERS 

NO OTHER ENTRIES* TRANSFER VECTOR - CARIGE, VECOUT. 
OUTPUTS QUANTITIES X1,X2,...,XN ONTO LOGICAL TAPE ITAPE ACCORDING TO 
FORMAT FMT(I), WHERE FMT(I) IS A NORMLIT FORMAT VECTOR AS DEFINED IN 
CVSOUT ABOVE, PRECEDED BY NSPACE SPACES COR PAGE RESTORE IF NSPACE IS 
LSTHN 0). SPACE! 1.. .N) USED FOR SCRATCH. EQUIVC SPACE ,X1 1 OK IF N»l. 



VSOUT (ITAPE, NSPACE, XI, X1NAME, X1FMT, IL01, IHU, FAP, 37 REGISTERS 

X2,X2NAME,X2FMT, IL02, IHI2, . . . ,XN,XNNAME, 
XNFMT, ILON, IHIN) 

NO OTHER ENTRIES. TRANSFER VECTOR - VOUT. 
CALL VSOUT( ABOVE ARGUMENTS) IS EQUIVALENT TO 

CALL VOUTC ITAPE, NSPACE, XI, X1NAME , XiFMT, IL01,IHI1) 
CALL VOUT( ITAPE, NSPACE, X2, X2NAME , X2FMT , IL02, IHI2I 
ETC 

CALL VOUT( ITAPE, NSPACE, XN,XNNAME, XNFMT, ILON, IHIN) . 



VTIMSV (X,Y,LXY,XTIMSY) FAP, 34 REGISTERS 

OTHER ENTRY - XVTMSV. NO TRANSFER VECTOR. 
SETS XTIMSYU...LXY) FROM XC1...LXY) AND YC1...LXY), WHERE 
XTIMSYU) = X(I)»Y(I). EQUIV(XTIMSY, X OR Y) OK. STRAIGHT RETURN 
IF LXY LSTHN 1 . 



WAC (LY,Y,LA, A) FORTRAN, 107 REGISTERS 

NO OT^ER ENTRIES. NO TRANSFER VECTOR. 
SETS All. ..LA) = ACI0...LA-1) WHERE AC(D * SUM (FROM J = 1 TO LYI 
OF (Y(J)*Y( J*L>) WHERE Y(K) TREATED « ZERO FOR K GRTHN LY. LY AND 
LA MUST EXCEED 0, LA MAY EXCEED LY. 



WHERE (SUBRU,IANS,LOC,NARGS) FAP, SECONDARY ENTRY OF LOCATE 

SUBRU IS PROXY NAME OF SUBROUTINE TO BE FOUND THROUGH TABLES 
ESTABLISHED BY PRIOR CALL LOCATE STATEMENT ( S ) . IF FOUND WHERE SETS 
LOC * MACHINE ADDRESS OF ENTRY POINT OF SUBROUTINE WITH PROXY NAME 
SUBRU (ASSUME REAL NAME IS SUBR) AND SETS NARGS = NO. ARGUMENTS 
IN THE CALL SUBR STATEMENT FOLLOWING THE DEFINITIVE CALL LOCATE. LOC 
AND NARGS UNDISTURBED IF NOT FOUND. SETS IANS * 0 IF FOUND, LSTHN C 
IF NOT. IANS * -1 IF TABLES OK, = -2 IF SUBRU FOUND IN A CALL LOCATE 
BUT ASSOCIATED CALL LIST TOO SHORT, = -3 IF NO CALL LOCATE YET MADE, 
= -4 IF EXCESSIVE NO. OF CALL LOCATES. 



WHICH F(X1,X2,ZIFX1) FAP, 4 REGISTERS 

OTHER ENTRY - XWHICH. NO TRANSFER VECTOR. 
HAS VALUE = XI IF ZIFX1«0.0, VALUE * X2 IF ZIFX1 NOT* 0.0 . 

WLLSFP (LR,R,G,LA,A,C) FORTRAN, 217 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - FDOTR, FOOT, MOVE. 
SOLVES FOLLOWING TOEPLITZ MATRIX EQUATION, SUM (FROM N=C TO M) 
OF (AA(N)*RR(K-N) * GG(K) K*O...M, AND FINDS AA(O...N) GIVEN 
GG(O...M) AND ANY RR(G...M,M+1) WITH IMPLIED SYMMETRY RR(-I)*RRtI) 
FOR WHICH THE (M»1)»(M*1I TOEPLITZ FORM R(K-N) IS POSITIVE 
DEFINITE. SUPPOSE LA IS POSITIVE (MUST EXCEED 1). THEN M IS 
TAKEN = LA-1 AND WLLSFP SETS AU...LA) * AA(O...M) TAKING 
RR(O...M) FROM R( 1.. .M+l. ..LR*1 ) AND GG(O...M) FROM G( 1. « .M+l. •• LR) 
WHERE LR GRTHN* LA, USING C(1...2»LR) AS SCRATCH (WILL CONTAIN 
LEVINSON AUXIL SEQUENCE CC(O...M) PLUS OTHER STUFF). NOW SUPPOSE 

(CONTINUED NEXT PAGE) 



«»»••»•*»••••»•»•••*••»* 

* WLLSFP TO XCMPRA » 
••*»••••»•»»••»»*•»•»*»» 



PROGRAM OIGESTS 



»*•»*»****•«••#»««*«««•* 

• WLLSFP TO KCMPRA * 
•»*••»*•«••««*•*•••«•«** 



LA IS NEGATIVE (LSTHN* -21. WLLSFP ASSUMES THAT THIS IS REPEAT CALL 
WITH DESIRE TO EXTEND PREVIOUS SOLUTION WITH M»LLA-1 (LLA* 
MAGNITUDECLA) ) TO NEW M * LR-1 AND THAT AU...LLA) AND CC 1. .-LLA) 
ARE UNDISTURBED FROM THAT CALL. SOLUTION WILL BE AS BEFORE WITH RESULTS 
SET IN AU...LAAI AND LA SET ■ LLA. 

WRTDAT ( I TAPE t DATA f LD AT A t I ANS ) FAP, 77 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - < IOS) , ( TCO) , (WRS) , (RCH) , (TRCI , 
(ETT). 

WRITES A BINARY RECORD OF LENGTH LDATA ON LOGICAL TAPE ITAPE FROM 
THE FORTRAN- 1 1 VECTOR DATA( 1.. .LDATA) . SETS IANS » 0 IF ALL OK, 
* 2 IF A REDUNDANCY IS ENCOUNTERED, * 3 I F AN END TAPE MARK IS 
ENCOUNTERED, = -1 IF ITAPE LSTHN I OR GRTHN 20, = -2 IF 
LDATA LSTHN 1 . 

XACTEQFCX, Y) FAP, 11 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
HAS VALUE = 0 IF X AND Y ARE IDENTICAL INCLUDING SIGN BIT, 
VALUE = 1 IF X GRTHN Y, VALUE = -1 IF X LSTHN Y WHERE 
+0 GRTHN -0 AND MODES OF X, Y IMMATERIAL. 

XADDK (IC,IX1,IX2,...,IXN) FAP, SECONDARY ENTRY OF ACCK 

SETS IX1*IX1*IC IX2=IX2+IC, IXN*IXN*IC. EQUI V( ANY ARGUMENTS) IS 

OK, BUT INITIAL VALUE OF IC IS ALWAYS THE ADDEND. STRAIGHT RETURN IF 
N=0. 

XADDKS ( IC1, IX1,IY1,IC2,IX2,IY2,...,ICN,IXN,IYN) FAP, SECONDARY ENTRY OF ADCK 
SETS !Yl*IXl*IClt IY2=IX2+IC2, IYN*IXN+ICN. EQUI VC ANY TWO 

ARGUMENTS) OK BUT MAY CHANGE INPUTS ICJ OR IXJ. PROCESSING IS LEFT 

XARG F(LOCALL,NUMARG, IXVECT) FAP, SECONDARY ENTRY OF LOCATE 

FUNCTION WHICH IS IDENTICAL TO ARGF BUT GIVES FIXED POINT LABEL 
TO RESULT. 

XAVRGE (IX,LIX,IXAVG) FAP, 34 REGISTERS 

OTHER ENTRY - XAVRGR. TRANSFER VECTOR - XDIV,XDIVR. 
SETS IXAVG * Cl/LIX) » SUM (FROM 1= 1 TO LIX) OF UXCI), AS TRUNCATED 
FORTRAN II INTEGER. OVERFLOW WILL NOT OCCUR. STRAIGHT RETURN IF 
LIX LSTHN 1. 

XAVRGR (IX, LIX, IXAVG) FAP, SECONDARY ENTRY OF XAVRGE 

SAME AS XAVRGE EXCEPT OUTPUT IS ROUNDED NOT TRUNCATED. 

XBOOST (IX,LIX,IXRUE,IXBSTD) FAP, SECONDARY ENTRY OF BOOST 

SETS IXBSTDU...LIX) « IX( 1. . .L IX )♦ IXRI ZE. EQUIV( IX, IXBSTD) OK, AND 
EQUIVUXRIZE, SOME IX(D) OK, BUT INITIAL VALUE OF IXRIZE IS ALWAYS 
THE ADDEND. STRAIGHT RETURN IF LIX LSTHN 1. 

XCMPRAF(X1,X2) FAP, SECONDARY ENTRY OF CMPRA 

HAS VALUE = 0 IF XI AND X2 ARE IDENTICAL INCLUDING SIGN BIT, 
VALUE » 1 IF XI IS ALGEBRAICALLY GRTHN X2, VALUE « -1 IF XI 
IS ALGEBRAICALLY LSTHN X2 WHERE *0 GRTHN -0 AND MODES OF XI 
AND X2 IMMATERIAL. 



*»•»**•**»*»«•*»»****•** 

• XOANL TO XDVRKS » 
*»**»»*•••*»»••***••#*»• 



PROGRAM DIGESTS 



**»••*•***•»***#.•#««••»# 

• XOANL TO XDVRKS * 
**•»•»*«•«•*••»•*•«•«••• 



XDANL UX,N,M,DXX) FAP, SECONOARY ENTRY OF ADAM 

SETS DXXC-N+1...N+1) = DXC-N...N) WHERE DXCL) « X ( L ) * C CM/L»P I) » 
SINU*PI/M)), GIVEN XX t-N+1 . . .N+l ) * XC-N...N) WITH N GRTHN * 0 
AND M GRTHN 0 . EQUIV <DXX,XX) OK. 

XDANX UXX,N,M,IDXX) FAP, SECONDARY ENTRY OF ACANL 

SAME FUNCTION AS SUBROUTINE XDANL EXCEPT THAT INPUT IXX AND OUTPUT 
IDXX ARE FXD.PT. EQUIV (IDXX,IXX) OK. 

XDELTAFCARG) FAP, SECONDARY ENTRY OF DELTA 

HAS VALUE - 1 IF ARG C ANY MODE) » ZERO. OTHERWISE HAS VALUE « 
0 . 



XDFPRS UX,LIX,IXPRSDI FAP, SECONDARY ENTRY OF DIFPRS 

SETS IXPRSDC1)=XU), IXPRSDC I )*IXt 1 1 — I X( I — 11 FOR 1*2.. .LIX. 

EQUIVCIXPRSD,IX) OK. STRAIGHT RETURN IF LIX LSTHN 1. 

XDIV F(NUMERA, IDENOM) FAP, 27 REGISTERS 
OTHER ENTRY - XDIVR. NO TRANSFER VECTOR. 
FUNCTION WHOSE VALUE IS NUMERA/ IDENOM TRUNCATED TO FORTRAN II INTEGER. 
STRAIGHT RETURN IF IDENOM * ZERO. 



XDIVK (IC,IX1,IX2,...,IXN) FAP, SECONDARY ENTRY OF ADCK 

SETS IXl*IXi/IC, IX2=IX2/IC, IXN*IXN/IC, AS TRUNCATED FORTRAN II 

INTEGERS. EQUIV( ANY ARGUMENTSl OK, BUT INITIAL VALUE OF IC IS ALWAYS 
THE DIVISOR. STRAIGHT RETURN IF IC=G, OR N=0. 



XOIVKS CIC1,IX1,IY1,IC2, IX2,IY2,...,ICN,IXN,IYN) FAP, SECONDARY ENTRY OF ADCK 
SETS IYl»IXl/IClt IY2=IX2/IC2, IYN=IXN/ICN, AS TRUNCATED 

FORTRAN- I I INTEGERS. EQUI V( ANY TWO ARGUMENTS) OK BUT MAY CHANGE INPUTS 
ICJ OR IXJ. PROCESSING IS LEFT TO RIGHT. IYJ IS NOT COMPUTED IF 
ICJ=0 AT COMPUTATION TIME. STRAIGHT RETURN IF N*C. 



XDIVR F(NUMERA, IDENOM) FAP, SECONDARY ENTRY OF XDIV 

SAME AS XDIV FUNCTION EXCEPT OUTPUT IS ROUNDED, NOT TRUNCATED. 

XDPRSS (IX,LIX,IXSINK,IXLWRD) FAP, SECONDARY ENTRY OF BOOST 

SETS IXLWRDC1...LIX) » I X ( 1 . . . L I X )- 1 XSI NK. EQUI V C I X, I XLWRD ) OK, AND 
EQUIVUXSINK, SOME IXC I ) 1 OK, BUT INITIAL VALUE OF IXSINK IS ALWAYS 
THE SUBTRAHEND. STRAIGHT RETURN IF LIX LSTHN 1. 



XDVIDE (IX,LIX,IXDVSR,IXDVDD) FAP, 33 REGISTERS 

OTHER ENTRY - XDVIDR. TRANSFER VECTOR - XDIV, XDIVR. 
SETS IXDVDDC1...LIX) * IX (1 • . .L IX ) / I XDVSR AS TRUNCATED FORTRAN II 
INTEGERS. EQUIVCIX,IXDVDD) OK, AND EQUI V{ I XDVSR , SOME IXC 1 1 ) OK, BUT 
INITIAL VALUE OF IXDVSR IS ALWAYS THE DIVISOR. STRAIGHT RETURN IF 
IXDVSR=G, OR LIX LSTHN 1. 

XDVIDR (IX, LIX, IXDVSR, IXDVDD) FAP, SECONDARY ENTRY OF XDVIDE 

SAME AS XDVIDE BUT OUTPUT ROUNDED, NOT TRUNCATED. 

XDVRK CIC,IX1,IX2,...,IXN) FAP, SECONDARY ENTRY OF ADDK 

SAME AS XDIVK EXCEPT OUTPUT ROUNDED, NOT TRUNCATED. 

XDVRKS CIC1,IX1,IY1,IC2,IX2,IY2,...,ICN,IXN,IYN) FAP, SECONDARY ENTRY OF ADCK 
SAME AS XDIVKS, EXCEPT OUTPUT ROUNDED, NOT TRUNCATED. 



••»•»»»•••**•*»»*•»*•*»• 

* XFIXM TO XNARGS » 



PROGRAM DIGESTS 



•«»••*• »•••»»**•• #*»*»#« 

« XFIXM TO XNARGS ♦ 
*•*•»»••«••*«»»«••**««•# 



XFIXM FC JOBtFLTG) FAP, 31 REGISTERS 

NO OTHER ENTRIES* NO TRANSFER VECTOR. 
FUNCTION CONVERTS FLTG TO MACHINE LANGUAGE INTEGER. IF JOB = 0 FLTG IS 
TRUNCATED TO INTEGER* IF JOB NOT * 0 FLTG IS ROUNOED TO INTEGER. 
MAGNITUDE OF FLTG SHOULD BE LSTHN* 2»»27-l., IF BIGGER THE RESULT WILL 
BE CLIPPED TO THIS MAGNITUDE. 

X I NDEXFf LOCALL, NUMARG) FAP, SECONDARY ENTRY OF LOCATE 

FUNCTION PRODUCES INDEX WITH RESPECT TO COMMON OF ARGUMENT NO. NUMARG 
OF THE CALL STATEMENT AT MACHINE ADDRESS LOCALL, WHERE NUMARG GRTHN* 1 . 

XLCOMNFI Z I FACT) FAP, 14 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
GIVES THE LENGTH OF COMMON SPACE AVAILABLE BEYOND THE LAST STORED 
ROUTINE IF ZIFACT=G., OR THE TOTAL LENGTH OF COMMON SPACE 
DIMENSIONED BY THE ROUTINES IF ZIFACT NOT* 0. 



XLIMITFCX,XA,XB) 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 
HAS VALUE = 0 IF XLO LSTHN* X LSTHN* 
MIN(XA,X8) AND XHI * MAXCXA,XB), VALUE * 
VALUE = -1 IF X LSTHN XLO, WHERE +0 



FAP, 



25 REGISTERS 



XHI WHERE XLO * 

♦1 IF X GRTHN XHI, 
IS CONSIDERED * -0 IN 



THE COMPARISONS MADE, AND MODE OF ARGUMENTS IMMATERIAL. 



XLSHFTFt N, X) 

PERFORMS SAME FUNCTION AS LSHFT. 



FAP, SECONDARY ENTRY OF LSHFT 



XLOCV U0CV,Xi,X2,...,XN) FAP, 24 REGISTERS 

NO OTHER ENTRIES. NO TRANSFER VECTOR. 

XJ, FOR J=1...N WHERE N GRTHN* 1 . 



XMLPLY ( IX,LIX,IXMPLR,IXMPLD) FAP, SECONDARY ENTRY OF MULPLY 

SETS IXMPLDC 1 . . . L IX ) * IX < 1 . . .L IX )* I XMPLR. EQUI V < I X , I XMPLD ) OK, AND 
EQUIV1IXMPLR, SOME IXtlH OK, BUT INITIAL VALUE OF IXMPLR IS ALWAYS 
THE MULTIPLIER. OVERFLOW DANGER NOT CHECKED. STRAIGHT RETURN IF 
LIX LSTHN 1. 

XMULK UC,IXi,IX2,...,IXN) FAP, SECONDARY ENTRY OF AOCK 

SETS IX1*IX1*IC, IX2*IX2»IC, IXN=IXN*IC. EQUI VI ANY ARGUMENTS I OK, 

8UT INITIAL VALUE OF IC IS ALWAYS THE MULTIPLIER. OVERFLOW DANGER NCT 
CHECKED. STRAIGHT RETURN IF N*0. 

XMULKS <IC1,IX1,IY1,IC2,IX2,IY2,...,ICN,IXN,IYN) FAP, SECONDARY ENTRY OF ADCK 
SETS IY1*IX1»IC1, IY2*IX2*IC2, IYN*IXN»ICN. EQUIVC ANY TWO 

ARGUMENTS) OK BUT MAY CHANGE INPUTS ICJ OR IXJ. PROCESSING IS LEFT 
TO RIGHT. OVERFLOW POSSIBLE, NOT TESTED FOR. STRAIGHT RETURN IF N*0. 

XNAME F ( HNAMEl ,HNAME2 ) FAP, SECONDARY ENTRY OF LOCATE 

FUNCTION HAS VALUE * +0 IF HNAMEl AND HNAME2 (BOTH FORMATf A6 ) > 
ARE THE SAME HOLLERITH DISREGARDING LEADING SPACES, * -1 IF THEY DIFFER. 



XNARGS F ( LOCALL ) FAP, SECONDARY ENTRY OF LOCATE 

FUNCTION HAS VALUE * NO. ARGUMENTS ASSOCIATED WITH THE CALL 
STATEMENT AT MACHINE ADDRESS LOCALL, EXCEPT VALUE * -1 IF LOCALL 
NOT THE ADDRESS OF A CALL STATEMENT (I.E. NOT A TSX X,4) 



**»••***•»**»*»*•**•»*»» 
» XNTHA TO XSPECT » 
••»••*••*«•»»•»*•«»*»»*» 



PROGRAM DIGESTS •»*••»•*••••••*»*«»•••«* 

* XNTHA TO XSPECT * 
»•*•**»••»»«*•*«**»»«««<• 



XNTHA F(N,IA1, I A2, . . . , I AN, . . . ) FAP, SECONDARY ENTRY OF NTHA 

HAS VALUE * IAN WHERE IAN * N-TH ARGUMENT FOLLOWING N, EXCEPT 

VALUE = N IF N LSTHN* 0 AND VALUE IS UNPREDICTABLE IF N*l 
EXCEEDS ARGUMENT COUNT. 

XNTSUM (IX,LIX,IXISMDI FAP, SECONDARY ENTRY OF INTSUM 

SETS IXISMD(I) * SUM (FROM J * 1 TO II OF IXtll, 1*1. ..LIX. 
EQUIV(IXISMD,IX) OK* POSSIBLE OVERFLOW NOT CHECKED FOR. STRAIGHT 
RETURN IF LIX LSTHN i. 

XOOZE F ( INT ) FAP, 4 REGISTERS 

NO OTHER ENTRIES* NO TRANSFER VECTOR. 
HAS VALUE * +1 IF INT IS AN ODD FORTRAN-II INTEGER, VALUE * 0 
IF INT IS EVEN, WHERE SIGN OF INT IS IMMATERIAL. 

XREMAV (IX,LIX,IXAVG,IXNULD) FAP, 31 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - XAVRGR. 
SETS IXAVG * (l/LIXI»(SUM(FROM 1*1 TO LIXI OF IXiltl ROUNDED 
TO FORTRAN-II INTEGER, AND SETS IXNULDt I ) = I X ( 1 1- IXAVG 1 = 1. ..LIX. 
EQUIVI IX,IXNULD) OK. NO DANGER OF OVERFLOW IN COMPUTING IXAVG. 
STRAIGHT RETURN IF LIX LSTHN 1. 

XRFLEC (IX,LIX,IXMIRR,IXIMGE) FAP, SECONDARY ENTRY OF REFLEC 

SETS IXIMGE(1...LIX)*IXMIRR-IX(1...LIX). EQUIVt IXIMGE, IX) AND UXMIRR, 
ANY IX(I)) OK, BUT INPUT IXMIRR VALUE ALWAYS USED IN SUBTRACTION. 
STRAIGHT RETURN IF LIX LSTHN 1. 

XSAME F(X) FAP, SECONDARY ENTRY OF SAME 

FUNCTION DOES NOTHING BUT SUPPLY FIXED POINT LABEL FOR ITS ARGUMENT 
WHICH IS ANY MODE. 

XSMDEV (IX,IXBASE,LIX,ISMXMB) FAP, SECONDARY ENTRY OF SUMDFR 

SETS ISMXMB * SUM (FROM I * 1 TO LIX) OF ( I X( I )- IXBASE ) . POSSIBLE 
OVERFLOW NOT CHECKED FOR. STRAIGHT RETURN IF LIX LSTHN 1. 

XSMDFR (IX,IY,LXY,ISMXMY) FAP, SECONDARY ENTRY OF SUMDFR 

SETS ISMXMY * SUM (FROM I * 1 TO LIX) OF ( I X< I )- I Y ( I > ) . POSSIBLE 
OVERFLOW NOT CHECKED FOR. STRAIGHT RETURN IF LIX LSTHN 1. 

XSPECT (XCOR,N,COSTAB,SINTAB,M,JMIN,JMAX, FORTRAN, 523 REGISTERS 

CSP,SSP, SPACE, ERR) 

NO OTHER ENTRIES. TRANSFER VECTOR - SPLI T,COSI SP, REFIT, XLOC, 
KOLAPS,CHPRTS. 

SETS CSPU...JMAX-JMIN+1) * CS ( JM IN. . . JMAX ) AND SETS SSP ( I . . . JMAX- 
JMIN+1) * SS( JMIN...JMAX), WHERE CS(J) * SUM (FROM I = -N TO N) OF 
(XC( I)»COS(I*J*PI/MH AND SSU) * SAME SUM WITH SIN REPLACING CCS, 
GIVEN XCOR(-N+l...N+l) * XU-N...N), GIVEN 0 LSTHN* JMIN LSTHN JMAX 
LSTHN* M, AND GIVEN COSTAB( 1 . . .M*l ) * COS(I«PI/M) FOR 1*0.. .M 
AND SINTABU...M+1) * SIN(I*PI/M) FOR 1*0.. .M . SPACE IS 
SCRATCH AREA. IF M GRTHN N NO SCRATCH AREA IS NEEDED AND SPACE 
NOT USED. IF M LSTHN* N, 2*M*4 REGISTERS REQUIRED WHICH WILL BE 
TAKEN AS SPACE(1...2»M+4) IF USER HAS NOT MADE PERMI SSABLE EQUIV 
(SPACE, XCOR). IF EQUIV(SPACEtXCOR) HAS BEEN MADE THE 2«M*4 SCRATCH ARE 
TAKEN FROM XCOR( -M+l. . .MM I WHICH WILL REQUIRE 3 REGISTERS 
BEYOND XC0R(N+1) IN THE CASE M * N . SETS ERR * 0.0 IF ALL CK, 
* 1.0 IF N (MUST EXCEED 0), M, JMIN OR JMAX ILLEGAL. 



**»•»***»•»»»•*•»•»•»••• 

* XSQOEV TO XVDR8V » 
«*•»•*•**•••«••»*•*»•••• 



PROGRAM DIGESTS 



••»••*••*•••#•*»*••••*»* 

• XSQOEV TO XVDRBV » 
*••***•••««•*«***••*•««» 



XSQOEV (IX, IXBASE,LIX, ISSXMBI FAP, SECONOARY ENTRY OF XSQDFR 

SETS ISSXMB * SUM ( FROM I = I TO LIX) OF ( I X ( I )~ I XBASE ) SQUARED* 
POSSIBLE OVERFLOW NOT CHECKED. STRAIGHT RETURN IF LIX LSTHN I . 

XSQDFR (IX,IY,LXY,ISSXMYI FAP, 37 REGISTERS 

OTHER ENTRY - XSQDEV. NO TRANSFER VECTOR. 
SETS ISSXMY « SUM (FROM I * 1 TO LIX) OF (IXfl)-IY(I ) SQUARED. 
POSSIBLE OVERFLOW NOT CHECKED FOR. STRAIGHT RETURN IF LIX LSTHN 1. 

XSQRUT (IX,LIX,IXSQRT) FAP, 37 REGISTERS 

NO OTHER ENTRIES. TRANSFER VECTOR - FIXVR,SQRT. 
SETS IXSQRTU...LIX) * SQUARE ROOT (MAGNI TUDE ( I X ( 1 . . .L I X) ) > , ROUNDED TO 
NEAREST FORTRAN II INTEGER. EQUI V( I XSQRT, I X 1 OK. STRAIGHT RETURN IF 
LIX LSTHN 1. 

XSQSUM (IX, LIX, ISMSQX) FAP, SECONDARY ENTRY OF SQRSUM 

SETS ISMSQX = SUM (FROM I* 1 TO LIX1 OF IX(II»IX(I). OVERFLOW DANGER 
NOT CHECKED. STRAIGHT RETURN IF LIX LSTHN 1. 

XSQUAR (IX,LIX,IXSQRD) FAP, SECONDARY ENTRY OF SQUARE 

SETS IXSQRDU...LIXI * IXU...LIXI SQUARED. EQUI V( IX, I XSQRDI OK. 
OVERFLOW DANGER NOT CHECKED. STRAIGHT RETURN IF LIX LSTHN I. 



XSTEPCF(ARG) 

HAS VALUE 



FAP, 

1 OR 0 ACCORDING AS SIGN BIT OF 



SECONDARY ENTRY OF DELTA 
ARG IS PLUS OR MINUS. 



XSTEPLF(ARG) 

HAS VALUE 
HAS VALUE 



FAP, SECONDARY ENTRY OF DELTA 
1 IF ARG (ANY MODE) IS GRTHN* MINUS ZERO. OTHERWISE 
0 . 



XSTEPRF(ARG) 

HAS VALUE 
VALUE 0 



* 1 IF ARG 



FAP, SECONDARY ENTRY OF DELTA 
(ANY MODE) EXCEEDS ZERO. OTHERWISE HAS 



XSTLIN (IBASE,IDELTA,LIX,IX) FAP, SECONDARY ENTRY OF SETLIN 

SETS IXCI)*IBASE*(I-l!*!DELTAt 1 = 1. ..LIX. EQUI V( I BASE , IDELTA, ANY 
IX(I)> OK, INPUT VALUES OF IBASE AND IDELTA ALWAYS USED. STRAIGHT 
RETURN IF LIX LSTHN 1 . 

XSUBK (IC,IX1,IX2,...,IXN) FAP, SECONDARY ENTRY OF ADCK 

SETS IX1MXI-IC, IX2*IX2-IC, IXN=IXN-IC. EQUI V( ANY ARGUMENTS! OK, 

BUT INITIAL VALUE OF IC IS ALWAYS THE SUBTRAHEND. STRAIGHT RETURN IF 
N=0. 

XSUBKS (IC1,IX1,IY1,IC2,IX2,IY2,...,ICN, IXN,IYN) FAP, SECONDARY ENTRY OF ADCK 
SETS IY1=IX1-IC1, IY2«IX2-IC2, IYN*IXN-ICN. EQUI V( ANY TWO 

ARGUMENTS) OK BUT MAY CHANGE INPUTS ICJ OR IXJ. PROCESSING IS LEFT 
TO RIGHT. STRAIGHT RETURN IF N=0. 



XSUM ( IX,LIX,ISUMIX) FAP, SECONDARY ENTRY OF SUM 

SETS ISUMIX « SUM (FROM I » 1 TO LIX) OF IX(I). OVERFLOW DANGER NOT 
CHECKED. STRAIGHT RETURN IF LIX LSTHN 1. 



XVDRBV (IX,IY,LXY,IXDVBY) FAP, SECONDARY ENTRY OF XVDVBV 

IDENTICAL TO XVDVBV EXCEPT RESULTS ROUNDED, NOT TRUNCATED. 



«»»*•***•»*»•*»***»«*»•» 

* XVDVBV TO ZEFBIN * 
*****•»**»•*«»»•**•*»*»» 



PROGRAM DIGESTS 



* XVDVBV TO ZEFBIN • 
••••*•*«••**••»*•**•*••* 



XVDVBV (IX, IY,LXY, IXDVBY) FAP, 34 REGISTERS 

OTHER ENTRY - XVDRBV. TRANSFER VECTOR - XDIV,XDIVR. 
SETS IXDVBYU...LXY) FROM IXU...LXY) AND IYU...LXY), WHERE 
IXDVBY(I) = IX(I)/IY(I), TRUNCATED TO FORTRAN-I I INTEGERS. 
EQUI V( IXDVBYf IX OR IY) OK. STRAIGHT RETURN IF LXY LSTHN I . 

XVMNSV (IX, IY,LXY, IXMNSY) FAP, SECONDARY ENTRY OF VPLUSV 

SETS IXMNSYU...LXY) FROM IXU...LXY) AND IYU...LXY), WHERE 

IXMNSYU) = IXU)-IY(I). EQUI V( I XMNSY 9 IX OR IY) OK. STRAIGHT RETURN 
IF LXY LSTHN 1 . 



XVPLSV (IXflYfLXYf IXPLSYl FAP, SECONDARY ENTRY OF VPLUSV 

SETS IXPLSYU...LXY) FROM IXU...LXY) AND IYU...LXY), WHERE 

IXPLSY(I) = IXU)*IY(I). EQUIVUXPLSY, IX OR IY) OK. STRAIGHT RETURN 
IF LXY LSTHN I . 



XVTMSV ( IXtlYtLXYt IXTMSY) FAP, SECONDARY ENTRY OF VTIMSV 

SETS IXTMSYU...LXY) FROM IXU...LXY) AND IYU...LXY), WHERE 
IXTMSY(I) = IX(I)»IY(I). EQUIV( IXTMSY, IX OR IY) OK. NO OVERFLOW 
CHECK MADE. STRAIGHT RETURN IF LXY LSTHN 1 . 



XWHICHFCIXlf IX2 V ZIFIX11 FAP, SECONDARY ENTRY OF WHICH 

HAS VALUE = 1X1 IF ZIFXl^O.O, VALUE = 1X2 IF ZIFIX1 NOT* 0.0 . 

ZEFBCDF( ITAPE ) FAP, 54 REGISTERS 

OTHER ENTRY - ZEFBIN. TRANSFER VECTOR - (IOS),(RDS),(RCH)f ( TCO ) , 
(TEF),(TRC),(BSR). 

FUNCTION HAS VALUE = 0.0 IF NEXT RECORD ON LOGICAL TAPE NUMBER ITAPE 

IS AN END-OF-F ILE RECORD (BCD MODE), » 1.0 IF NOT ENG-GF-FILE, 
= -1.0 IF REDUNDANCY (10 READ ATTEMPTS MADE). TAPE IS LEFT UNMOVED. 

ZEFB INF ( I TAPE ) FAP, SECONDARY ENTRY OF ZEFBCD 

FUNCTION HAS VALUE * 0.0 IF NEXT RECORD ON LOGICAL TAPE NUMBER ITAPE 
IS AN END-OF-FILE RECORD (BINARY MODE), « 1.0 IF NOT END-OF-FILE, 
= -1.0 IF REDUNDANCY (10 READ ATTEMPTS MADE). TAPE IS LEFT UNMOVED. 



Program Statistics 



The program statistics tabulation below provides an alphabetically ordered listing of 
all entries, with their secondary entries, transfer vectors, storage requirements, 
acceptance dates* of symbolic decks, symbolic deck-card counts, binary deck-card 
counts, authors, programming language, and entry-name pronounciations. All numbers 
given in the tables are decimal. The symbol M is used for machine language (i.e., 
FAP) and F for FORTRAN. Authors are coded by initials as follows. 



AMN 


Arcadio M. Niell 


CP 


Cheh Pan 


EAR 


Enders A. Robinson 


IH 


Ira Hanson 


JC 


Jacqueline Clark 


JFC 


Jon F. Claerbout 


JNG 


James N. Galbraith, Jr. 


JTO 


J.T. Olsztyn 


JTP 


Joseph T. Procito, Jr. 


MIT 


MIT Lincoln Laboratory or Computation Center Staff 


RAW 


Ralph A, Wiggins 


RJG 


Roy J. Greenfield 


SMS 


Stephen M. Simpson, Jr. 



The pronounciations given approximate the conversational usage of our program- 
ming group. A letter followed by a period indicates a syllable pronounced as in 
alphabetic recitation of the letter. An unsyllabized word always receives ordinary 
pronunciation. A stress mark following such a word indicates that the whole word, 
rather than its last syllable, is accented. 



*See the discussion at the beginning of Section 10 for the meaning of this term. 
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***«•**•***»•*•••»*•»•»* 

* ABSVAL TO ARBCOL • 
*»*•**••*»**•***••»»**»* 



PROGRAM STATISTICS 



• »••••*•••••*••*«*•*:* 

ABSVAL TO ARBCCL • 



E S 




. T 




S . 


0 


S 


C . 


S c « 


B 


C . 


A 


» L • 


E P 


N E 




► R 




T . 


A 


Y 


A . 


Y A , 


I 


A « 


U 


. A . 


N R 


T C 




A 




0 


T 


M 


R . 


M R , 


, N 


R « 


T 


» N « 


T 0 


R 0 




, N 




R . 


E 


B 


0 . 


B 0 , 


A 


0 « 


H 


. G « 


R N 


Y N 


E « 


» S 




A . 




0 




0 


, R 




0 « 


. U « 


Y U 


D 


N , 


► F 


V 


G . 


0 


L 


0 . 


L C , 


. Y 


C ! 


R 


. A « 


N 


N A 


T . 


. E 


E 


E . 


F 


I 


E . 


I 0 . 




0 - 




. G . 


N C 


A R 


R , 


. R 


C 






C 


C . 


c u , 




U « 




> E « 


A I 


M Y 


I < 




T 








K . 


N , 




N « 






M A 


E 


E « 




0 










T « 




T . 






E T 




S < 




R 




















I 




























0 




























N 


ABSVAL 








! 50 \ 


9/29/64 . 


117 ! 




4 ! 


SMS 


• M • 


ABZ § VAL 



ADANL 

XDANL 
AOANX 
XDANX 

AOANX (SE 

ADDK 

SUBK 

MULK 

DIVK 

XADDK 

XSUBK 

XMULK 

XDIVK 

XDVRK 

ADDKS 

SUBKS 

MULKS 

DIVKS 

XADDKS 

XSUBKS 

XMULKS 

XDIVKS 

XDVRKS 

ADDKS (SE 

AMPHZ 
REIM 



ARBCOL 



SIN 



ADANL) 



ADDK) 



ATAN 

SQRT 
RND 
COS 
SIN 



INTOPR 



183 



114 



149 



129 



9/29/64 



9/29/64 



10/ 1/64 



9/ 9/64 



336 



366 



251 



271 



11 



10 



JFC 



SMS 



JFC 



SMS 



A. f DAN L. § 

A. f DAN X.» 
ADD* K. 



ADD KAYZ 1 
AMP« PHASE 



ARB* KAHL 



• ARCTAN TO CMPARP ♦ 
**•»«»»•*»*»•*••••«••«•• 



PROGRAM 



STATISTICS 



• ARCTAN TC CMPARP * 
*•••»»**»•••••**•••«•«•• 



ARCTAN 




AT AN 


29 . 


9/ 4/64 . 


92 . 


3 


. RAM < 


» M . 


► ARC f TAN 


ARG 


(SEE 


LOCATE ) • 














! ARG 


ASPECT 


• 
• 


i**f!t ADC 

COSP 
mini y 

OUBLL . 

CQI T T 
orL 11 • 

RVPRTS . 


278 I 


9/29/64 • 


536 I 


15 


! SMS ! 


! M , 


! ASPECT 


ASPEC2 




SEQSAC . 


74 ! 


3/15/65 • 


206 I 


5 < 


! SMS < 


> M 4 


► AS' PEK 2' 


AVRAGE 










TO 


3 i 


CM C 


» P. 4 




BLKSUM 




• 




*¥/ O** m 


1 AO 




CM C 


» W 4 


at nr it* i c 1 1 m 


BOOST 

XBOOST • 
OPRESS . 
XDPRSS • 


• 
• 


34 \ 


9/29/64 1 


147 I 


3 ! 


\ SMS ! 


! M , 


! BOOST 


CALL 


(SEE 


LOCATED 














► CALL 


CALL2 


(SEE 


LOCATE). 














. CALL • 2' 


CARIGE 




(STHI . 

1 C Tl 1 

irlLI • 


HI • 


Q/OQ / i /. 

V'<cV'O i t # 




*t 4 


CMC 


c 

► r 4 


r add r A rc 
CAKK I Abfc 


CHISQR 








Q / *>Q /i/ 

V CTJ* OH • 




O 4 


► JlMb 4 


c 

► r 4 


► 1\A 1 w oftc K 


CHOOSE 




* 


17 \ 


9/ 4/64 . 


84 . 


2 ! 


! SMS ! 


. M 4 


! CHOOSE 


CHPRTS 

RVPRTS • 




76 . 


9/29/64 . 


149 . 


5 . 


! SMS I 


» M 4 


, CHEH PARTS' 


CHSIGN 








Q/1Q / /LA 




C 4 


CMC 
► OHO 4 


M 

► n 4 


rucu r fMCt 
tncn o liMC: 


CHUSET 


(SEE 


INDEX* I 














rMHt CCT 


CLKON 




CL0CK1 . 
(SPH> . 
(FID . 


46 \ 


9/29/64 I 


42 I 


4 4 


. RAW « 


F 4 


CLOCK' ON 


CLOCK1 


(7090* I 


57 \ 


3/15/65 I 


148 . 


4 4 


, SMS ! 


M 4 


CLOCK* 1' 


CMPARL 


(SEE 


CMPARV). 














KUM PAR* L. 


CMPARP 






53 \ 


9/29/64 . 


151 I 


4 4 


SMS ! 


M . 


KUM PAR' P. 



CMPARS 



*•••*••*»••»*•**»******• 

• CMPARS TO COSISP » 
•*»»»•••»*»»•••»•»»**»•• 



PROGRAM 



STATISTICS 



•»*•»«*•••••«»•*•«••**«* 

* CMPARS TO COSISP * 
•»»•••••»••••*••»««*•••• 



CMPARS 


{ SEE 


CMPARP 1 • 














► KUM PAR f S« f 


CMPARV 

CMPARL • 




50 - 


9/ 4/64 • 


156 . 


4 ■ 


! SMS 1 


M « 


, KUM PAR* V. 1 


CMPRA 

XCMPRA . 
CMPRFL . 




18 . 


9/ 4/64 . 


104 . 


2 ! 


. RAW • 


M , 


► KUM* PRUH 


CMPRFL 


(SEE 


CMPRA) • 














► KUM f PRUH FUL 


CNTRDB 




SETVEC \ 
LOG 

CONTUR . 
EXP 
SAME 
(STH) • 
(FID . 


550 \ 


9/ 9/64 • 


251 I 


2? 1 


! SMS I 


F \ 


\ CONTOUR 1 D. 8. 


CNTROW 


• 


RNDDN . 
RNDUP . 
QUFITl • 
CUFITi . 
FASCUB • 
RND 


802 ! 


9/ 9/64 . 


521 I 


39 ! 


! SMS I 


F ! 


\ CONTOUR* ROW 


COLABL 


• 

• 


GENHOL \ 
(SPH) . 
(FID . 
(STH) • 


185 ! 


9/ 4/64 I 


124 I 


10 ! 


! SMS \ 


F \ 


! KAH* LAH BUL 


COLAPS 


• 




50 « 


9/29/64 . 


128 . 


4 < 


\ JC I 


M « 


► COLLAPSE 


CONTUR 




RNDDN • 
RNDUP . 
(STH) • 
(FID • 
COLABL . 
ARBCOL • 
CNTROW . 
SWITCH • 
(SPH) . 
XSAME . 


587 ! 


9/ 9/64 . 


642 I 


29 ! 


\ SMS I 


F , 


► CONTOUR 

* , 


CONVLV 






96 . 


9/29/64 . 


99 . 


6 < 


. JFC • 


F , 


. CONVCLVE 


CONVLV- 


ii ! 




56 ! 


10/ 2/64 I 


149 . 


4 ! 


\ JFC + I 
► RAW * 


M , 


! CONVOLVE 1 DASH 


COSISP 


(SEE 


COSP) . 














! KOH* SISP 



••*•*»••*•***•*•»*•*••*» PROGRAM STATISTICS *»•****»*»•«••*•«••••**» 

» COSIS1 TO CVSOUT * » COSISl TO CVSOUT « 

•**«••••••»*•»*•»»*«*»•• »*»••»• *•***« •••*#* •****» 



COSISl \ 


IXCARG • 
SPLIT . 
MOVREV • 
CHPRTS . 
COSP 
SISP 

COSISP . 


406 ! 


9/10/64 ! 


264 1 


21 


\ RAW , 


. F < 


! KOH f SIS l f 


COSP 

SISP 

COSISP . 




504 . 


9/29/64 . 


878 I 


27 ! 


. SMS , 


► M « 


. KAHSP 


COSTBL \ 
SINTBL . 
COSTBX . 
SINTBX • 


COS \ 
SIN 


121 . 


9/29/64 . 


200 . 


8 , 


! JFC « 


» M , 


► KAHSS 1 TUH BUL 


COSTBX ( SEE 


COSTBL K 














KAHSS f TUB 


CPYFL2 


UOS) \ 
CTCO) . 
(WR5) . 
CRCH) • 
CTRC) • 
(ETT) . 
(WEF> . 

(Rosi I 


178 . 


9/ 9/64 . 


304 . 


10 , 


. RAW < 


, M , 


COPY* FILE 2 f 


CROSS 


STZ I 
FOOT 


107 . 


9/29/64 . 


87 . 


7 , 


► RAW , 


» F « 


CROSS 


CROST ! 


CROSS • 
REVERS • 


134 I 


9/29/64 . 


99 • 


8 < 


, RAW « 


F ! 


CROSS* T.» 


CRSVM 


SETKS • 
MDOT3 • 
STZ 


327 . 


9/10/64 ! 


220 • 


17 « 


, RAW . 


F . 


C. f R . S. V. M.« 


CSOUT 


CARIGE . 
(STH) • 
HRADJ . 
(FID ♦ 


49 • 


9/ 4/64 I 


127 I 


4 ! 


, RAW < 


M « 


SEEZ* OUT 


CUFIT1 




158 I 


9/ 4/64 . 


326 . 


9 « 


> SMS ! 


M . 


C. f FIT 1» 


CVSOUT 


CARIGE ! 


84 I 


9/29/64 . 


221 I 


6 « 


► SMS « 


M . 


C. 1 VEEZ • OUT 



•**••••»•*•**»»*••*•••»» PROGRAM STATISTICS •••*«•»«•»••*••#•«*•*•*» 

» CVSOUT TO DUBLX • • CVSOUT TO DUBLX » 

«»*»•»*»*»»*•*••»•****•» •*»••«•*«••«*•»*»«•«««•• 







FMTOUT . 
VECOUT • 
















DADECK 




EOFSET I 
i TSH) . 
(RTN) . 
(STH) . 
(FILI . 
RSKIP . 


100 • 


9/ 4/64 . 


70 \ 


6 « 


, JNG*. 
, RAW . 


F \ 


DAY* DECK 


DELTA 

XDELTA . 
STEPR • 
XSTEPR . 
STEPL . 
XSTEPL . 
STEPC . 
XSTEPC . 


• 

• 
• 


17 . 


9/ 4/64 . 


141 . 
• 
• 


2 , 


. SMS • 


M , 


► DELTA 


DERIVA 






61 


9/29/64 I 


160 I 


5 ! 


\ SMS I 


M « 


> DEH RIV« UH 


DETRM 


( SEE 


SIMEQ) ! 














► D. TERM* 


DIFPRS 

XDFPRS • 




30 ! 


9/29/64 1 


118 \ 


3 ! 


[ SMS ! 


M , 


! DIF« PERZ 


DISPLA 


(709 


) 

(IOHI . 


220 . 


9/29/64 . 


474 • 


12 \ 


► MIT . 


M , 


, DISPLAY 


DISPLA 


(7090) 

. (IOH) • 
• FRAME . 


219 . 


9/ 4/64 


481 . 
• 


13 , 


! MIT I 


M \ 


! DISPLAY 


DIVIDE 






23 « 


9/29/64 . 


88 . 


3 « 


! SMS I 


M « 


► DIVIDE 


DIVK 


(SEE 


ADDK) . 














. DIV» K. 


DIVKS 


(SEE 


ADDK ) . 






• 








! DIV KAYZ • 


• i DO ti 


(SEE 


SEVRALI. 






• 








, DO 


DOTJ 






59 . 


10/ 2/64 . 


143 . 


4 , 


> RAW • 


M , 


! DOT* J.« 


DOTP 




DOTJ I 


264 ! 


9/29/64 • 


147 \ 


14 \ 


[ RAW \ 


F ! 


. DOT* P. f 


DPRESS 


(SEE 


BOOST) ! 














! DEPRESS 


DSPFMT 






194 , 


9/29/64 ♦ 


313 \ 


11 \ 


\ SMS \ 


M « 


! DISP 1 FUM ET 


DUBLL 


(SEE 


DUBLX) I 














! DOUBLE • L. f 


DUBLX 

DUBLL . 




45 ! 


9/29/64 . 


129 \ 


4 \ 


\ SMS I 


M « 


> DOUBLE* X. f 



•»••*••«»»»••«••*»••«••* 

» DUBLX TO FLOATM » 



PROGRAM STATISTICS 



« DUBLX TO FLOATM » 



HALVX . 
HALVL . 


















ENDFIL 


(SEE 


REREAD ) • 














! END* FILE 


EOFSET 


CSEE 


REREAD) 1 














! E.» 0. F«« SET 


EXCHVS 






22 • 


9/29/64 . 


84 • 


3 « 


. SMS 


• M « 


■ EX« CHEH VEEZ 


EXPAND 


• 

• 


• 

INTOPR \ 


189 I 


9/ 4/64 . 


380 \ 


11 


! SMS , 


> M , 


. EXPAND 


FACTOR 


• 
• 

• 


MAXAB \ 
LOG 

COSTBL . 

COSP 

EXP 


308 I 


9/ 8/64 I 


489 . 


17 \ 


! JNG 1 


! M ! 


! FACTOR 


FAPSUM 


• 


• 


14 . 


9/29/64 • 


66 . 


2 ! 


! jfc ! 


, M « 


FAP» SUM 


FASCN1 


• 


• 


107 . 


9/29/64 I 


199 • 


7 , 


. SMS ! 


. M < 


! FASS« SCAN !• 


FASCOR 


( SEE 


PROCOR). 














FASS« CORE 


FASCR1 


(SEE 


PROCOR). 














FASS f KER 1« 


FASCUB 




• 


141 I 


9/ 4/64 • 


260 \ 


9 , 


! SMS ! 


. M . 


FASS« CUBE 


l-AbfcPC 




KKULUK ) • 














I-A55* fc. P» C* 


FASEP1 


(SEE 


PROCOR). 














FASS f E. P. 1» 


FASTRK 






26 1 


9/ 8/64 . 


119 I 


3 1 


! SMS ! 


! m ! 


FASS» TRACK 


FOOT 

FDOTR . 




40 . 


9/ 4/64 • 


101 . 


3 « 


, RAW « 


► M « 


F.« DOT 


FDOTR 


(SEE 


FDOT) \ 














F.« DOT R.« 


FIRE2 




• 

IXCARG . 

STZ 

DOTP 

MATMi 1 

DOTJ 


271 I 


9/ 8/64 . 


152 ! 


14 ! 


, RAW , 


► F ! 


FIRE 2 f 


FIXV 

FIXVR . 




35 . 


9/29/64 . 


105 \ 


3 - 


SMS . 


M . 


FIX* V. f 


FIXVR 


(SEE 


FIXV) . 














FIX» V. R.» 


FLDATA 


(SEE 


FXDATA). 














FLOW f DATA 


FLOATM 






25 • 


9/29/64 . 


91 . 


3 , 


SMS ! 


n . 


FLOAT 1 M.« 



*»•**•»••»«*•»•*••»«*»•» 

* FLOATV TO GNHOL2 » 



PROGRAM 



STATISTICS 



« FLOATV TO GNHOL2 • 



FLOATV 




22 ! 


9/29/64 . 


81 I 


3 ! 


! SMS ! 


M « 


! FLOAT 1 V.* 


FMTOUT 


FNDFMT . 
RPLFMT . 
(STH) . 
(FID . 


51 ! 


9/29/64 \ 


11 I 


4 ! 


! SMS \ 


F ! 


! FUMT* OUT 


FNDFHT 


REVER . 


88 ! 


9/29/64 \ 


203 I 


6 ■ 


\ SMS ! 


M 1 


\ FIND • FUMT 


FRAME (709) 




4 , 


9/29/64 . 


34 • 


2 . 


> RAW « 


M « 


» FRAME 


FRAME (7090) 


9 . 


9/ 4/64 . 


47 \ 


2 < 


! MIT ! 


M , 


\ FRAME 


FRQCTl I 




117 \ 


9/29/64 \ 


95 \ 


7 ! 


! SMS ! 


► F ! 


\ FREE • COUNT l f 


FR0CT2 




117 ! 


9/29/64 I 


212 I 


7 ! 


> JNG ! 


M 1 


! FREE • COUNT 2* 


FSKIP 

• 

* 


(IOS) . 
(RDS) • 
(BSR) . 
(TCOI . 
(TEF) . 
(TRC) . 


50 « 


9/ 4/64 . 


104 . 


4 < 


► JFC « 


M « 


> F*« SKIP 


FT24 


FXDATA . 


111 \ 


9/29/64 . 


848 . 


40 \ 


! cp ! 


M < 


! F.»T. 24« 


FT24 -II 1 




818 ! 


9/29/64 I 


147 \ 


39 ! 


! RAW ! 


► F ] 


! F.»T« 24* DASH 


FXDATA 

FLDATA . 




102 ! 


10/ 1/64 • 


248 • 


7 ! 


! SMS ! 


M « 


! FIX* DATA 


GENHOL 


(IOH) • 


48 - 


3/15/65 I 


145 \ 


4 « 


[ RAW ! 


M « 


! JEN* HAHL 


GETHOL 1 


XLOC 
REVERS • 


169 \ 


9/29/64 . 


176 I 


9 « 


! SMS ! 


. F , 


! GET f HAHL 


GETRD1 


(TSH) • 
(RTN) • 


229 ! 


10/ 1/64 1 


173 1 


10 1 


! SMS ! 


■ F ! 


\ GET* R. C. 1« 


GETX 

IGETX . 




31 ! 


9/ 4/64 ] 


128 I 


3 ! 


. RAW . 


» M ! 


! GET f X, 


GNFLT1 


COS ! 


232 ! 


9/29/64 * 


164 \ 


12 ! 


! SMS ] 


! f ! 


! JEN f FILT I* 


GNH0L2 


(IOH) . 


74 ! 


9/29/64 I 


158 ! 


5 


. RAW « 


! m ! 


» JEN f HAHL 2 1 



»***»»»»*«•**»*»*»*«»*•» PROGRAM STATISTICS #•«•###**»*#»«*«*•»***•# 

♦ GNHOL2 TO IFNCTN * ♦ GNHOL2 TO IFNCTN • 

***«•**•**••*•*»••**»»»« *••*»•»••»•«•»*••»•••«•• 







(FID . 


















GRAPH 




DISPLA ! 
(SPH) . 
(FID . 
LINE 

LUb • 

EXP(2 . 
XFIXM . 
FLOATM • 

r» c&ciiT 
USrrHI • 

FRAME • 
yi nr 

ALUU • 
MVBLOK . 

HSTPLT . 


1499 « 


> 9/29/64 ! 


1103 I 


72 


! SMS 


. F < 


. GRAPH 




GRAPHX 




GRAPH . 
FRAME • 


123 ! 


9/29/64 ! 


154 I 


7 


! SMS ! 


. F < 


> GRAPH* X.« 




bKUP<c 






201 • 


10/ 1/64 • 


141 • 


1 1 . 


» JNG 4 


► F i 


Nomina > 

► GROUP' Z B 




HALVL 


(SEE 


DUBLX) . 














► HALVE" L.» 




U At \l V 

HALVa 


t c c c 


DUBLX I • 














► HALVE" Am 9 




HLAOJ 


%> • 




46 . 


9/29/64 * 


111 I 


4 < 


! SMS « 


. M « 


! H. L.* ADJUS 




HRAOJ 


(SEE 


HLAOJ 1 . 














, H. R.« ADJUS 




UCTDI T 

Ho 1 PL 1 




LINEH . 
LINEV . 


14!> • 




346 • 


9 t 


» JNG « 


► M 4 


Uf CTIDI f"IT 

HIST 1 PLU I 




HSTPLT- 


II 1 


LINEH • 
LINEV . 


188 . 


9/29/64 I 


336 . 


11 1 


. RAW < 


> M « 


HIST«PLOT DASH 


2« 


HSTPLT- 


III* 


(709) 
LINEH • 


256 . 


9/29/64 . 


438 . 


14 , 


► RAW < 


, M . 


HIST»PLOT DASH 


3 f 


HSTPLT- 


III 


(7090) . 
LINEH . 


258 I 


9/ 8/64 . 


446 • 


14 , 


► RAW , 


M « 


HIST'PLOT DASH 


3 f 


HVTOIV 






39 I 


9/29/64 • 


110 I 


3 ! 


! SMS ! 


M ! 


H.» V. TO !•• 




IOERIV 






54 • 


9/29/64 . 


149 . 


4 , 


SMS ! 


M . 


!•• DEH RIV 




»'IF»« 


(SEE 


SEVRALK 














IF 




IFNCTN 




MONOCK . 
REVER . 


208 . 


9/ 4/64 • 


444 . 


12 ! 


SMS ! 


M . 


FUNCTION 





••*••••**«••»*»•»»*••»•* 

* IGETX TO KIINT1 • 



PROGRAM 



STATISTICS 



*••****••••«•••••»•«•••• 

* IGETX TO KIINT1 » 
»•••»*••••*••»•••»•«•«•• 



IGETX (SEE 


GETXI 1 














!•• GET X. 


IINTGR I 




49 ! 


9/29/64 I 


157 I 


4 « 


SMS \ 


M . 


!•• INT« GR 


I NO ATA ! 

• 
* 


VARARG • 
FSKIP . 
(TSB> 
(RLR» . 
FAPSUM . 
LOC 

MVBLOK . 
XSAME . 
(SPH) 
(FID . 
(STH) . 
UNPAKN . 


896 . 


10/ 1/64 ! 


489 . 


32 ! 


\ JFC ! 


F • 


IN f DATA 


INDEX ! 
VINDEX • 
SETEST . 
SETAPT . 
CHUSET • 


• 
• 


50 ! 


9/ 4/64 . 


270 . 


4 , 


\ SMS ! 


! M « 


INDEX 


INTGRA 




47 « 


9/29/64 . 


175 . 


4 , 


, SMS « 


» M . 


INT» GRAH 


INTHOL ! 

• 


• 

FNDFMT . 
(IOH) . 
(RTN) . 


72 ! 


9/ 9/64 . 


156 I 


5 ! 


, RAW - 


! M 1 


INT« HAHL 


INTMSB (SEE 


TIMSUBK 














IN* TUM SUB 


INTOPR 




ill « 


9/ 4/64 • 


251 ! 


7 , 


► SMS « 


► M « 


INT* AH PER 


INTSUM ! 
XNTSUM . 


• 


27 ! 


9/29/64 • 


110 I 


3 , 


! SMS ! 


! M « 


INT § SUM 


IPLYEV 


(IFMP) . 


98 , 


10/ 2/64 . 


84 . 


6 « 


1 RAW « 


. F , 


I.» POLLY 1 EV 


ITOMLI 




37 ! 


9/29/64 • 


98 . 


3 « 


! SMS ! 


! M - 


IT f UM LEE 


IVTOHV 




70 ! 


3/15/65 . 


148 \ 


5 \ 


! SMS ! 


> M . 


I. f V* TO H. f 


IXCARG 


XLOC 


35 ! 


. 9/29/64 • 


67 1 


3 ! 


! SMS , 


► F « 


IX* KARG 


KIINT1 I 


SQRT 

EXPO . 
NOINTl . 


191 , 


9/29/64 . 


129 \ 


10 * 


! SMS ! 


> F « 


KAI • INT !• 



•»*••»••*••••••*****»••» 

* KOLAPS TO LSSS1 ♦ 



PROGRAM 



STATISTICS 



* KOLAPS TO LSSS1 » 
**••••••*•»••*•#»*#••••# 



KOLAPS 


• • 


100 . 


9/29/64 • 


219 . 


6 < 


. JC « 


M . 


KOH* LAPSE 


LIMITS 


• • 


44 ! 


9/ 8/64 ! 


162 1 


4 « 


! SMS ! 


► M ! 


LIMITS 


• • 

LINE (709) 


91 « 


9/29/64 « 


193 • 


6 4 


! SMS ! 


, M . 


LINE 


LINE (70901 


95 ! 


9/ 4/64 • 


208 I 


6 « 


! SMS ! 


► M ! 


LINE 


• • 

LINEH (709) 


34 ! 


9/29/64 ! 


158 \ 


3 , 


, JNG . 


► M « 


LINE • H. • 


LINEH (70901 


35 ! 


9/ 4/64 . 


168 ! 


3 ! 


! JNG ! 


> M , 


L INE • H.» 


LINEV (709) 


34 ! 


9/29/64 ! 


161 I 


3 ! 


► JNG « 


, M ! 


LINE • V. f 


• • 

LINEV (7090) 


35 ! 


9/ 4/64 « 


169 . 


3 « 


» JNG « 


► M , 


LINE • V. § 


LINTR1 


• • 

• • 


96 . 


9/29/64 . 


93 I 


6 , 


► SMS « 


► F , 


LIN* TER l f 


LISTNG 


• • 

• • 

. (RWT) . 
. (STH) 
. (FIL) . 
. (TSB) . 

• (RLR) 

. FAPSUM • 

• SAME • 
. XSAME . 

• (SPH) . 
. FSKIP . 

• >* 1 1 1 • r\c • 


755 ! 


9/29/64 ! 


221 . 


38 ! 


. RAW « 


► F , 


► LISTING 


LOC 


• • 


4 ! 


9/29/64 « 


54 I 


2 ! 


. RAW « 


! M , 


! LCKE 


LOCATE 
WHERE 
CALL 
CALL2 
SETSBV 
SETUP 
RETURN 
XINDEX 
ARG 
XARG 
STORE 
XNARGS 
XNAME 


• • 

• • 

• • 

• • 

• • 

• • 

• • 

• • 

• • 

• • 

• • 

• • 

• • 


512 ! 


3/15/65 I 


2008 1 


28 , 


! SMS ! 


! M ! 


! LOCATE 


LSHFT 

XLSHFT 


• • 

• • 

• • 


12 ! 


9/29/64 « 


72 I 


2 ! 


. RAW « 


! M 1 


! L.« SHIFT 


LSLINE 




117 ! 


10/ 1/64 ! 


82 1 


7 ! 


. RAW « 


! F ! 


! L. S. LINE* 


LSSS1 


• • 

• * 

. FOOT 

• • 


122 « 


9/29/64 • 


116 . 


7 ! 


„ RAW , 


► F ! 


. L* f S. S. S 



»*•••»•*»*••*»***••**••• PROGRAM STATISTICS 

* MATINV TO MINSNM * » MATINV TO MINSNM * 

#»•»**»*»»*•«»*»•»»*•••• ••»•»••••»«**•«•••*•••»• 



MATINV 


SIMEQ ! 


90 . 


9/29/64 . 


79 . 


6 . 


» RAM • 


f , 


► MAT 9 


INV 


MATML1 


• 


61 . 


9/29/64 I 


137 \ 


5 < 


. RAW . 


M , 


, MAT* 


MUL l 9 


MATML3 \ 


DOTJ . 


120 • 


9/29/64 I 


105 \ 


7 i 


. RAW . 


F , 


► MAT* 


MUL 3 9 


MATRA 




92 . 


9/29/64 . 


177 * 


6 . 


» RAW*. 
. SMS . 


M , 


, MAY* 


TRAH 


MATRA1 




42 . 


9/29/64 . 


95 • 


4 < 


» RAW ♦ 


M « 


. MAY 9 


TRAH 1* 


MAXAB (SEE 


MAXSN1 . 














» MAX 9 


AB 


MAXABM (SEE 


MAXSNM). 














! MAX 9 


UH BIM 


MAXSN 

MINSN . 
MAXAB • 
MINAB . 


• 


54 I 


9/29/64 . 


170 \ 


5 ! 


\ JFC \ 


M ! 


► MAX 9 


SIN 


MAXSNM 

MINSNM . 
MAXABM . 
MINABM . 


• 
• 


61 • 


9/ 4/64 • 


247 • 


5 « 


» SMS • 


M 4 


. MAX 9 


SNIM 


MOOT • 


MATML1 * 


109 • 


9/29/64 • 


94 • 


7 < 


> RAW • 




» M« 9 


DOT 


MDOT3 


MATML3 ! 


122 . 


9/29/64 I 


120 \ 


7 < 


. RAW . 


F ! 


. M. 9 


DOT 3 9 


MEMUSE I 


XLCOMN \ 
(STH) . 
(FIL) . 


71 I 


9/ 4/64 ! 


69 \ 


5 ! 


! SMS I 


F ! 


! MEM 9 


YEWSS 


MFACT 

• 


STZ ! 

DOTJ 
SQRT 


187 • 


9/29/64 • 


103 • 


10 « 


» RAW • 


F « 


► M. 9 


FACT 


MIFLS 


MOVREV • 
MATML3 . 


276 . 


9/ 8/64 . 


167 I 


14 « 


» RAW . 


F , 


■ MIFFLES 


MINAB (SEE 


MAXSN) ! 














! MIN 9 


AB 


MINABM (SEE 


MAXSNM). 














MIN 9 


UH BIM 


MINSN (SEE 


MAXSN) . 














> MIN 9 


SIN 


MINSNM (SEE 


MAXSNM)! 














MIN 9 


SNIM 



* MIPLS TO HULK • 
**»»•»•••»••»*••»»••«»•• 


PROGRAM 


STATISTICS 


•••••••*•»•••«*•••*•••* 

• MIPLS TO MULK 


MIPLS 


IXCARG . 
MATINV . 
MATML3 . 
MATRA • 
MDOT3 . 
MuVKfcV • 
STZ 


571 « 


. 9/29/64 « 


► 254 • 


28 


. RAW . 


F • MIPPLES 

• 
• 


MISS 


MOVREV • 
MATML3 • 
MDOT3 . 


335 \ 


10/ 5/64 , 


150 \ 


17 , 


, RAW . 


F • MISS 


MLISCL 




47 « 


9/29/64 « 


115 \ 


4 « 


! SMS \ 


M . HUH LIS f KUHL 


MLI2A6 




128 . 


9/29/64 ! 


218 . 


8 . 


> SMS *. 


M • MILLIE* TO A. 6 f 


MONOCK I 




48 \ 


9/ 4/64 \ 


165 \ 


4 4 


! SMS I 


M . MAHN • AHK 


MOUT 


CARIGE • 
(STH> . 
(FID . 


130 . 


9/ 8/64 « 


101 • 


8 < 


. RAW . 


F . MOUT 


MOUTAI 


EXP(2 \ 
CARIGE . 
GNH0L2 . 

LOG 

RND • 
(STH) . 
(FILI • 
SAME . 
MOVE 

MULPLY . 
FIXVR • 


357 • 


9/ 4/64 . 


295 \ 


18 ! 


! SMS I 


F • MOUT' TAI 

• 


MOVE 


• 


32 . 


9/29/64 ! 


92 . 


3 « 


» JFC . 


M • MOVE 


MOVECS • 


MOVE 


24 • 


9/29/64 . 


106 • 


3 « 


SMS • 


M • MOO" VEX 


MOVREV 


• 


74 \ 


9/29/64 \ 


156 \ 


5 \ 


RAW . 


M . MOVE« REV 


MPSEQ1 




110 • 


9/29/64 . 


197 . 


1 , 


JNG I 


M . MAP* SEEK 1« 


MRVRS 


REVERS • 


61 • 


9/29/64 . 


67 • 


4 « 


RAW . 


F . MER* VERZ 


MSCON1 




238 1 


9/29/64 . 


108 ! 


11 ! 


JNG . 


F . MISS • KAHN l f 


MULK (SEE 
• 


AOOKI . 












. MUL • K. 



• MULK TO NXALRM » 



PROGRAM 



STATISTICS 



*••«••»*»••*•••*»••••••* 

» HULK TO NXALRM * 
•*»•»•••«»•*••»•»#•••••« 



MULK - 


II . 


SETUP . 
ARG 
STORE 
RETURN . 


76 . 


9/29/64 . 


78 • 


5 « 


► SMS • 


F , 


► MUL 9 K. DASH 


MULKS 


(SEE 


ADDK ) . 














► MUL KAYZ 9 


MULLER 




SQRT 


757 ! 


9/ 9/64 . 


232 . 


36 i 


> IH ] 


F « 


. MULLER 


MULPLY 

XMLPLY . 




34 m 


9/29/64 • 


114 . 


3 « 


» SMS . 


M , 


► MUL 9 PLEE 


MUVAOD 






129 . 


9/29/64 • 


245 • 


8 « 


» SMS • 


M , 


► MOVE * AOO 


MVBLOK 




• 


19 . 


9/29/64 • 


83 • 


2 . 


► SMS • 


M « 


MOVE 1 BLOCK 


MVINAV 




• 


221 - 


9/29/64 • 


116 • 


12 « 


► SMS • 


F , 


» MOVING* AV 


MVNSUM 




• 


71 ! 


9/ 4/64 • 


202 ! 


5 ! 


! SMS I 


M « 


MOVING 1 SUM 


MVNTIN 

MVNTNA . 


• 


88 ! 


9/ 4/64 I 


234 . 


6 < 


! SMS • 


M « 


► MOVING TEEN* 


MVNTNA 


(SEE 


MVNTINI • 














> MOVING TEEN 9 


MVSQAV 






236 . 


9/29/64 • 


116 • 


13 < 


► SMS . 


F , 


» MUHV 9 SKAV 


MXRARE 




EXP(2 


302 ! 


9/29/64 I 


250 1 


16 ! 


! SMS I 


F ] 


► MAX* RARE 


NEXCOS 


(SEE 


SEQSAC ) • 














NEX 9 KOHSS 


NEXSIN 


(SEE 


SEQSAC ) 1 














► NEX 9 SINE 


NMZMG1 






34 . 


9/29/64 • 


97 . 


3 * 


» RAW • 


M « 




NOINT1 

NOINT2 . 


LINTR1 • 


369 . 


9/29/64 I 


375 ! 


20 ! 


! SMS+I 
► JNG • 


M « 


! NOINT 9 l 9 


NOINT2 


(SEE 


NOINT1 ) . 














► NOINT 9 2 9 


NRMVEC 




SQRT 

MAXAB . 


Ill - 


9/29/64 • 


100 • 


7 « 


» RAW • 


F « 


► NORM 9 VEK 


NTHA 

XNTHA . 




ii ! 


10/ 6/64 ! 


93 . 


2 - 


! SMS ! 


M , 


► ENTH 9 UH 


NURINC 






121 . 


9/ 4/64 ! 


327 ! 


8 - 


! SMS I 


M ! 


! NEW 9 RINK 


NXALRM 






243 . 


9/29/64 . 


178 . 


13 « 


! SMS I 


F « 


► NEX 9 ALARM 



FASCN1 



»*••••*••**••*•»•**»«•»• 

* ONLINE TO PLOTVS » 



PROGRAM 



STATISTICS 



••»•••••»*••••*•«*#••«*• 

» ONLINE TO PLOTVS » 



ONLINE 
(STH) 
CSTHM) 
( STHDl 



OUDATA 



PACDAT 



PAKN 



PLANSP 



PLOTVS 



{ IOH) 
( WER) 
CTES) 
(WRSI 
(WTO 
CRCHI 
(FID 
CSPHI 



VARARG 
LOC 

MVBLOK 

FAPSUM 

PAKN 

(STB I 

(WLRJ 

(EFT) 



(IOS) 
(TCO) 
(RDS) 
(RCHI 
(ETT) 



FXDATA 



SETKS 

LIMITS 

IXCARG 

CHOOSE 

XOOZE 

MOVREV 

STZ 

ROAR2 

XAOOKS 

KOLAPS 

COSTBL 

SINTBL 

XAODK 

COSIS1 

MATRA 



SETVEC 

SETKS 

SETKV 

(STH) 

(FID 

SWITCH 

(SPH) 

RND 



134 



495 



152 



78 



1169 



494 



4/14/65 . 191 



3/15/65 



9/ 9/64 



9/29/64 



9/ 9/64 



9/ 4/64 



269 



259 



147 

383 



261 



8 • RAW • M • ON* LINE 



11 



56 



18 



JFC 



RAW 



JFC 



RAW 



SMS 



OW» OATA 



PACK* DAT 



PACK • N. • 



PLANSP 



PLOT* VEEZ* 



**•»•»*•*»•*»»•»»»*•*•** 

* PLTVSi TO PROCOR » 



PROGRAM 



STATISTICS 



••»•»••••••••*•«•••»••*• 

• PLTVSI TO PROCOR * 



PLTVSI ! 

* 
• 

• 

• 


VARARG • 
SETKS . 
SETVEC . 
SETKVS . 
XSTLIN . 
XLOC 

XSAME • 
RMSDEV • 
(STH) 
(FILI . 
MAXSN • 
MINSN • 
MULPLY . 
BOOST . 
PLOTVS . 
DPRESS . 


817 I 


9/ 4/64 . 


393 . 


40 « 


. SMS \ 


F ! 


> PLOT* VEEZ 


PLURAL (SEE 


SEVRALI. 














► PLURAL 


PLURNS 




73 ! 


9/29/64 I 


247 • 


5 « 


\ SMS \ 


M , 


PLURNS 


PLYSYN 


COS 

CONVLV . 


172 • 


10/ 5/64 • 


162 . 


10 , 


» EAR . 


F « 


» PLEE f SIN 


POKCT1 1 


FRQCT1 • 


219 ] 


9/29/64 ! 


134 I 


11 \ 


! SMS \ 


F ! 


! POH* COUNT 


POLYOV 

• 


MOVE 
STZ 


130 ! 


9/ 9/64 * 


102 ! 


7 ! 


! JFC + I 
. RAW . 


F ! 


! POLLY* DIV 


POLYEV 




54 , 


9/29/64 . 


62 . 


4 « 


. JFC • 


F « 


► POLLY* EV 


POLYSN 

- ■ • 


SQRT ! 
COS 

CONVLV • 
MOVE 


256 ! 


9/ 8/64 \ 


167 * 


14 \ 


. RAW • 


F ! 


! POLLY* SIN 


POWER 

SMPROV . 


EXP(2 I 


50 • 


9/29/64 . 


13C I 


4 « 


\ SMS \ 


M « 


> POWER 


PRBFIT 


SQRT 

EXP(2 . 
EXP 


373 ! 


9/29/64 . 


187 . 


16 \ 


\ RJG 1 


F « 


, PRAHB* FIT 


PROB2 




229 ! 


10/ 6/64 ! 


175 I 


12 ! 


\ JNG ! 


F \ 


! PRAHB* 2* 


PROCOR 

FASCOR . 
FASEPC . 




770 ! 


9/29/64 ! 


1499 . 


40 , 


\ SMS \ 


n « 


. PROH* CORE 



•*•***•»•»•»»••*»****»•» 

* PROCOR TO QXCOR1 # 



PROGRAM 



STATISTICS 



*•*#»•••*«••»•*•••# #•*** 

• PROCOR TO QXCOR1 • 
*»»««•»*»••*»*••*••••••» 



FASCRl 
FASEPl 


















PSQRT 


! SQRT ! 


155 . 


10/ 5/64 . 


91 . 


9 , 


► JFC « 


! F 1 


► P. f SQUIRT 


PWMLIV 


• MLI2A6 • 
. (STH) . 

• (FID • 
. (SPH) . 


300 « 


9/29/64 • 


142 • 


15 \ 


. SMS « 


► F « 


, PWIM" LIV 


QACORR 


. FXOATA • 
• PROCOR . 
. FASCOR . 
. FLDATA . 


207 • 


9/29/64 . 


184 . 


11 « 


► SMS < 


, F , 


► KACK • CORE 


QCNVLV 


! XLOC I 
. FXOATA . 
. PROCOR . 
• FASCOR • 
. FASEPC • 
. FLDATA . 


569 « 


9/29/64 ♦ 


294 • 


27 ] 


\ SMS , 


> F , 


> Q.« CONVOLVE 


QFURRY 


[ STZ ! 
. MOVE * 

• WUO 1 UL • 

. SINTBL . 
. XSPECT . 


244 


9/29/64 . 


181 


13 < 


! SMS , 


► F « 


» Q. f FURRY 


QIFURY 


► COSTBL • 
» SINTBL . 
. COSISP . 
» XLOC 


280 . 


9/29/64 . 


206 I 


14 , 


! SMS ! 


► F « 


, Q. lm 9 FURRY 


QINTR1 


. RNDUP . 
► QUFITl • 


229 ! 


9/ 4/64 . 


192 . 


12 ! 


! JTP I 


■ F < 


! KINT • ER l f 


QUFITl 




79 . 


9/ 4/64 . 


200 I 


5 ! 


! SMS ! 


, M , 


! C. f FIT !• 


QXCORR 


. XLOC 
. FXOATA . 
. PROCOR . 
, FASCOR . 
. FLDATA . 


283 ! 


9/29/64 I 


249 I 


15 ! 


! SMS 1 


! f ! 


[ KIX« CORE 


QXCOR1 


. SETKS . 
. IXCARG . 


502 . 


3/15/65 . 


198 . 


25 « 


> RAW - 


» F < 


! KIX» CORE !• 



•***•»*•»*•*»»•••»••»»•• 

* QXC0R1 TO RLSPR2 * 



PROGRAM 



STATISTICS 



•••»••••*•••*«••*•#*•••* 

« CXCOR1 TO RLSPR2 * 
»•**•»»»»•*•*•»•••«••*•« 



RDATA 



REFIT (SEE SPLIT) 



REFLEC 

XRFLEC 



RE IM 
REMAV 



REREAO 

EOFSET 
ENDFIL 
CTSH) 
CTSHM) 



RETURN (SE 
REVER 
REVERS 
RLSPR 

RLSPR2 



LIMITS 
STZ 

REVERS 
PROCOR 
FASCRi 
FASEPi 



SETUP 

RETURN 

IXCARG 

CTSH) 

(RTN) 

{ STH) 

<FIL) 

HVTOIV 

IVTOHV 

CMPRA 

ARG 

INTHOL 

STORE 



i SEE AMPHZ) 



( IOH) 

(RDS) 

(RDC) 

(RCH) 

<TCO) 

(TEF) 

EXIT 

(RER) 

LOCATE) 



FDOTR 



IXCARG 
STZ 

MOVREV 
DOTP 



645 



28 

36 
114 



3/15/65 



9/29/64 

9/29/64 
9/ 9/64 



396 



108 

106 
283 



31 



30 . 


9/29/64 . 


98 • 


3 < 


. SMS , 


■ M , 


. REV* ER 


29 • 


9/29/64 . 


77 I 


3 , 


. RAM . 


► H , 


! REVERSE 


142 ! 


10/ 5/64 I 


121 • 


8 « 


> RAW « 


I F ! 


, R. f LISPER 


700 . 


9/ 9/64 I 


281 I 


34 ! 


» RAW , 


. F « 


! R. f LISPER 



RAW 



SMS 

SMS 
RAW 



R. f DATA 



REE* FIT 

REE § FLEK 

REE" IM 

REM* AV 

REE* READ 



RETURN 



«•*«•»»«••»••••»*•*•»•»• 

• RLSPR2 TO SEARCH » 



PROGRAM STATISTICS 



» RLSPR2 TO SEARCH # 



RLSSR 



RMSDAV (SEE 

RMSDEV 

RMSDAV 



RND 



RNOUP 
RND ON 



RNDDN 
RNOUP 



(SEE 
(SEE 



RNDV 

RNOVUP 
RNOVDN 



RNDVDN (SEE 
RNDVUP (SEE 
RQAR2 

ROTAT1 
RPLFMT 



RSKIP 

(IOS) 
( TRC ) 
(TCOJ 
(TEF) 
(RDS) 
(BSR) 

RVPRTS (SEE CHPRTS) 

SAME 

XSAME 

SCPSCL 

SEARCH 



MATML3 

DOTJ 

SIMEQ 



FDOTR 
RMSDEV) 

SORT 



RND) 
RND) 

RND 

RNOUP 

RNDDN 

RNDV) 

RNDV) 



MATRA 

MOVREV 

REVERS 



82 



50 



15 



34 



174 

46 

17 
37 



33 
25 



9/29/64 

9/ 4/64 
9/29/64 



9/29/64 



9/10/64 

9/ 4/64 

9/29/64 
9/29/64 



9/29/64 

9/29/64 
9/29/64 



115 



160 



79 



118 



114 

110 

85 
90 



40 

111 

95 



RAW 



SMS 



RAW 



SMS 



RAW 



RAW* 
JC 

SMS 

RAW 



JFC 

SMS 
RAW 



R.* LESSER 

R. M. S. DAV* 
R. M. S. DEEV B 

ROUNO 

ROUND* DOWN* 

ROUND* UP* 

ROUND* V.* 

ROUND* V, DOWN* 
ROUND* V* UP* 
ROAR* 2* 

ROTATE* 1* 

RIPPLE* FUMT 
R.* SKIP 



REV* PARTS 
SAME 

SKUP* SCALE 
SEARCH 



#*••*••••***•»••••••**** 

* SEQSAC TO SETVEC ♦ 
•*•••»»••»•»•»*••*•*•»*• 



PROGRAM 



STATISTICS 



•*•••••••••••••*•**»•••« 

» SEQSAC TO SETVEC • 
••*•»••»*••••»•••«••»••* 



SEQSAC 

NEXCOS • 
NEXSIN . 


COS \ 
SIN 


94 . 


9/ 8/64 . 


278 . 


6 . 


. SMS , 


► M « 


SEEK 


• SACK 


SETAPT (SEE 


INDEX) . 














SET 


APT* 


SETEST (SEE 


INDEX) \ 






• 








! SEH 


TEST* 


c c t r kin 

or I I NU • 


XLIHIT \ 
(RUT) . 
( TSB) . 
(RLR) . 
FSKIP • 


84 • 


9/ 8/64 • 


92 • 


6 * 


► SMS « 


► F . 


SEH 


TEE* Nun 


SETK I 
SETKS . 
SETVEC . 




37 \ 


9/29/64 . 


190 \ 
* 


3 ! 


! SMS ! 


, M , 


! SET* 


K. • 


SETK -II . 


SETUP ! 
STORE . 
RETURN . 


63 • 


9/29/64 • 


73 . 


4 , 


► SMS « 


► F « 


, SET* 


K. DASH 


SETKP 

SETVCP • 


SETK • 
SETVEC . 


40 \ 


9/29/64 \ 


124 \ 
• 


3 , 


! SMS ! 


! M i 


SET' 


K. P.* 


SETKS ( SEE 


SETK) \ 






• 








SET* 


KAYZ* 


SETKS -II \ 
• 


SETUP \ 
ARG • 
STORE • 
RETURN . 


91 . 




86 • 
• 


6 - 


! SMS ! 


! F ! 


SET* 


KAYZ DAS 


SETKV * 




15 ♦ 


9/29/64 . 


75 • 


2 « 


. SMS , 


> M « 


► SET 1 


K. V. • 


SETKVS • 


• 


25 . 


9/29/64 • 


106 • 


3 « 


► SMS « 


► M « 


► SET* 


K. VEEZ* 


SETLIN • 
XSTLIN . 


* 


27 . 


9/29/64 • 


95 • 


3 « 


► SMS « 


► M « 


► SET f 


LIN 


SETLNS \ 


SETLIN . 
XSTLIN . 


39 \ 


9/29/64 . 


124 I 


3 ! 


! SMS ! 


► M ! 


! SET* 


LINZ 


SETSBV (SEE 


LOCATE). 














! SET* 


SUB V.* 


SETUP (SEE 


LOCATE). 














! SET* 


UP 


SETVCP (SEE 


SETKP) \ 














! SET* 


V.C.P.* 


SETVEC (SEE 


SETK) . 














! SET* 


VEK 



•»»*•»•••••*»•»••••••••• PROGRAM STATISTICS »»»*•»•»•#•»»»»»»•#••»## 

* SEVRAL TO SQROOT • * SEVRAL TO SQROCT * 



SEVRAL 

PLURAL • 
••DO 11 • 
••IF** . 


LOCATE I 
WHERE . 


416 • 


9/29/64 . 


949 . 


22 


. SMS . 


M < 


. SEV* RUL 


SHFTR1 


• 


70 . 


9/29/64 I 


158 I 


5 , 


! SMS I 


M « 


\ SHIFT* ER 1* 


SHFTR2 


• 


72 I 


9/29/64 I 


163 I 


5 


. SMS+I 
. RAW . 


M « 


! SHIFT* ER 2* 


cut ICCI 

• 


GETRD1 I 
SEARCH • 
SIZEUP . 


101 • 


9/ 8/64 • 


125 • 


6 4 


» SMS • 


F 4 


CUIICCI c 

» SHUFFLE 


SIFT I 


• 


30 . 


9/ 4/64 . 


118 ! 


3 < 


! SMS ! 


M , 


! SIFT 


SIMEQ I 
OETRM . 


• 


441 • 


9/ 9/64 1 


642 I 


24 < 


\ JTO*. 
» AMN+. 

n 1 Li 

» KAN • 


M « 


! SIME* E. Q. 


MNToL lotc 


Cub 1 BL I • 














» o INc ■ TUB L • ■ 


SINTBX (SEE 


C0ST8L 1 • 














. SINE' TUB X«" 


SIbP (SEE 


COSPI • 














even 
► 5 15P 


SIZEUP I 
SIZUPL . 




136 I 


3/15/65 I 


247 I 


8 , 


. RAH*. 
► SMS . 


M « 


SIZE* UP 


SIZUPL (SEE 


SIZEUP ) 1 














> SIZE* UP L.* 


CUDOHU 1 err 

brlPKuv lace: 


PUWcK) • 














oun" rtK UfctV 


S MP SON 




317 I 


9/ 4/64 . 


197 I 


17 ! 


\ JNG ! 


F « 


! SMIP* SON 


SPC0R2 

• 
• 


• 

XLOC • 
STZ 

FXDATA • 
QXC0R1 • 
FLOATA . 


291 I 


9/ 8/64 . 


181 I 


15 1 


, RAW . 


F - 


SPUH CORE* 2* 


SPLIT 

REFIT . 


• 


224 1 


9/29/64 . 


395 . 


13 « 


! SMS \ 


M « 


SPLIT 


SQRDEV (SEE 


SQRDFR )! 














SKUR DEEV* 


SQRDFR 

SQRDEV . 




36 • 


9/29/64 I 


ill I 


3 ! 


\ SMS I 


M . 


SKUR DIFFER* 


SQRMLI 




55 • 


9/29/64 . 


128 . 


4 < 


\ SMS I 


M . 


SQUIRM* LEE 


SQROOT I 


SQRT 


24 1 


9/29/64 . 


83 1 


3 ! 


! SMS \ 


M . 


SKUH ROOT* 



••»•»»»•«»»•*•»•»•»••»•• 

* SQRSUM TO TINGL * 
***•**•**••**•••**•••»*• 



PROGRAM STATISTICS 



• SQRSUM TO TINGL • 
*•••«»*••••••*»•*•*«*••» 



SQRSUM 

XSQSUM . 

SQUARE I 
XSQUAR . 

SRCH1 

. XACTEQ 
STEPC (SEE DELTA) 
STEPL ( SEE OELTAI 
STEPR (SEE DELTA) 
( STH) (SEE ONLINE I 
(STHD) (SEE ONLINE) 
(STHM) (SEE ONLINE) 
STORE (SEE LOCATE) 
STZ • 
STZS I 
SUBK (SEE ADDK) 
SUBKS ( SEE ADDK) 
SUM 

XSUM 

SUMDEV (SEE SUMDFR) 

SUMDFR 

XSMDFR . 
SUMDEV • 
XSMDEV . 

SWITCH 

TAMVL 

TAMVR • 

TAMVR ( SEE TAMVL) 

TIMA2B (7094) 



TIMSUB 

INTMSB . TIMA2B 

TINGL ! 
TINGLA • 



36 



32 



93 



14 
24 



23 

44 

15 
63 

124 
229 
43 



9/29/64 



9/29/64 



9/ 8/64 



9/29/64 
9/29/64 



9/29/64 

9/29/64 

9/ 4/64 
9/ 4/64 

9/ 9/64 
9/ 8/64 
9/ 8/64 



107 
ill 
93 



60 
97 



92 

156 

84 
189 

258 
450 
147 



13 



SMS 



SMS 



RAW 



JFC 
SMS 



SMS 



SMS 



SMS 
SMS 



SMS* 
RAW 

SMS* 
RAW 

SMS 



SKUR SUM 1 

SQUARE 

SEARCH* l 1 

STEP' C 1 
STEP* L. 1 
STEP 1 R. • 
S. 1 T. H. 1 
S. 1 T. H« D. 1 
S. 1 T. H. M. 1 
STORE 
S. T. Z. 1 
S. T. ZEEZ 1 
SUB 1 K. 
SUB KAYZ • 
SUM 

SUM DEEV 1 
SUM DIFFER 1 

SWITCH 
TAM 1 VUL 

TAM 1 VER 

TIME 1 A. 1 TO B« 1 
TIME 1 SUB 
TINGLE 



» TINGLA TO WAC * 
••*•••»•*»**•»••»**»•»«» 



PROGRAM 



STATISTICS 



*»»#»*»»#»»»»*»«♦•#••#•• 

» TINGLA TO MAC • 



T r Mfl A 

1 l NbLA 


• 

fCCC 


T f All* 1 1 














» TING' GLAH 


tdu r Kin 


• 


XLIMIT . 

ni in a t a 
UUUA 1 A • 

FSKIP • 

f D UT 1 


67 • 


9/ 4/64 • 


• 

77 • 
• 


5 


> SMS < 


» F < 


Tim yrrm r*iti 

► TUR rEEN* OH 


I I orl I 


f c c c 


KcRfcAU 1 • 






• 










(TSHM) 


(SEE 


REREAD) 1 














► T.« S. H.« M.» 


UNPAKN 






78 • 


9/ 9/64 . 


150 . 


5 ! 


► JFC < 


. M 4 


► UNPACK* N. f 


1/ in ad r* 
V ARAKb 






A A 


a /*><*» / a a 
9/Z9/64 • 


132 • 


4 < 


» JFC * 


» M 4 


win | an/t 

► VAR' ARB 


VDOTV 


• 


• 


25 • 


9/ 4/64 • 


121 • 


3 4 


» SMS « 


» M 4 


► V» ■ DOT V» ■ 


VUVdt V 


• 


• 


Hi. • 


Q / O Q / A A 

9/«t9/oH • 


9U • 


5 i 


cue 
» oMo < 


► M 4 


» V« 1 u* V« ■ BY V • ■ 


VECOUT 


• 


FMDFMT • 
RPLFMT . 
(STH) . 
(FID . 


66 \ 


9/29/64 • 


91 I 


5 ! 


! SMS ! 


► F , 


! VEK» OUT 


VINOEX 


{ SEE 


INDEX) . 














► V. f INDEX* 


VMNUSV 


(SEE 


VPLUSV). 














, V. f MINUS V. f 


VOUT 




CARIGE . 
HRADJ . 
(STH) . 
l r IL ) • 

VECOUT . 


1 AA 

104 • 


Q / ">Q / A A 

9/Z9/OH • 


tit 
111 • 




CMC 

» brio * 


► r 4 


i V • ■ UU I 


VPLUSV 

XVPLSV . 
VMNUSV . 
XVMNSV • 


• 


1 A 


O/IQ / A A 


1Z F • 




CMC 

► ono « 


u 

► r 4i 


\l • Dl tlC \i 1 

¥• * r LUo V • 9 


VRSOUT 




• 

CARIGE . 
VECOUT . 


47 I 


9/29/64 I 


138 I 


4 « 


! SMS , 




VERZ f OUT 


VSOUT 




VOUT 


37 I 


9/29/64 . 


125 I 


3 ! 


SMS ! 


M . 


VEEZ* OUT 


VTIMSV 

XVTMSV . 




34 I 


9/29/64 . 


112 * 


3 1 


SMS ! 


M . 


V.« TIMES V.» 


WAC 






107 . 


9/29/64 . 


83 . 


6 , 


JFC « 


F « 


HACK 



»»•**»•*•»•*•**•****•»•• 

* WHERE TO XOPRSS * 
*••»••»«»•»*»••»*•*»«»•» 



PROGRAM STATISTICS 



•*•»*•»•«**•*•*••••••«•• 

» WHERE TO XOPRSS » 
•*»*••»••••»••••»•••*•«• 



WHERE CSEE LOCATE) 

WHICH ] 
XWHICH . 



WLLSFP 



WRTDAT 



XACTEQ 

XAODK (SEE 

XADOKS (SEE 

XARG (SEE 

XAVRGE 

XAVRGR . 

• 

XAVRGR ( SEE 

XBOOST (SEE 

XCMPRA (SEE 

XDANL (SEE 

XOANX (SEE 

XDELTA (SEE 

XDFPRS (SEE 

XOIV 

XDIVR . 

• 

XDIVK (SEE 
XDIVKS (SEE 
XDIVR (SEE 
XDPRSS (SEE 



FDOTR 

FOOT 

MOVE 



(IOS) 
(TCO) 
(WRS) 
(RCH) 
(TRC) 
(ETT) 



ADOK) 
ADDK) 
LOCATE) 

XDIV 
XDIVR 

XAVRGE) 

BOOST) 

CMPRA) 

ADANL) 

ADAND 

DELTA) 

DIFPRS) 



ADDK) 
ADDK) 
XDIV) 
BOOST) 



217 



77 



11 



34 



27 



9/ 4/64 



10/ 6/64 



9/ 8/64 



9/ 4/64 



9/29/64 



9/29/64 



77 



264 



126 



76 



104 



109 



11 



SMS 



RAW 



RAW 



SMS 



SMS 



SMS 



WHERE 



WHICH 



WILL • USS FUHP 



WRITE 1 DAT 



EXACT' E. Q. 
X. ADD' K. 
X, ADD KAYZ 1 
X. ARG' 
X. AV REDGE 

X. AV« REDGE R • B 
X. BOOST* 
X. KUM' PRA 
X.' DAN L.' 
X. 1 DAN X«» 
X. DELTA' 
X. D IFF' PURZ 
X, DIV 

X. DIV K. 

X. DIV KAYZ' 

X. DIV ER 

X. DEPRESS' 



*»*»•••*•**•*•*«*«»»»•*» 

» XDVIDE TO XSPECT * 



PROGRAM 



STATISTICS 



• XDVIDE TO XSPECT * 
••»«•«••**•»***«•••«•«•* 



XDVIDE 
XDV 


• 

IDR • 
• 


XDIV . 
XDIVR . 


33 • 


9/29/64 . 


105 • 


3 « 


, SMS « 




► X* 


DIVIDE 1 


XDVIDR 


(SEE 


XDVIDE ) 1 














► X* 


DIVIDE R.* 


XDVRK 


(SEE 


ADDKI . 














\ X. 


DIV* ER K.» 


XDVRKS 


(SEE 


ADDK) . 














> X. 


DIV* ER KAYZ • 


XFIXM 


• 
• 


• 


31 . 


9/29/64 . 


98 . 


3 \ 


! SMS ] 


, V « 


, X. 


FIX* UM 


X INDEX 


(SEE 


LOCATE ) • 














» X. 


INDEX' 


XLCOMN 


• 

• 




14 I 


9/ 4/64 . 


76 . 


2 « 


. RAW « 


> W « 


► X. 


• L. COMMON* 


XLIMIT 


• 
• 




25 \ 


9/ 4/64 ! 


101 \ 


3 \ 


! SMS ! 


► N , 


■ X. 


LIMIT* 


XtOCV 


• 


• 


24 I 


9/ 4/64 . 


100 . 


3 \ 


! SMS \ 


> H < 


. X. 


LCKE V.* 


XLSHFT 


(SEE 


LSHFT) I 














. X. 


L.* SHIFT 


XMLPLY 


(SEE 


MULPLY). 














» X. 


MUL * PLEE 


XMULK 


(SEE 


ADDK) . 














► X. 


MUL* K. 


XMULKS 


(SEE 


ADDK) . 














. X. 


MUL KAYZ* 


XNAME 


(SEE 


LOCATE). 














> X. 


NAME* 


XNARGS 


( SEE 


LOCATE ) • 














> X* 


NARGS * 


XNTHA 


• 

( SEE 


NTHA) 














► X* 


ENTH* UH 


XNTSUM 


( SEE 


INTSUM ) . 














» X. 


INT* SUM 


XOOZE 






4 . 


9/ 4/64 . 


61 • 


2 « 


► SMS « 


M » 


X* 


OOZE* 


XREMAV 


• 
• 


• 

XAVRGR . 


31 • 


9/29/64 • 


112 • 


3 « 


» SMS « 


M « 


. x« 


REH MAV* 


XRFLEC 


• 

(SEE 


REFLEC). 














x. 


REE FLEK* 


XSAME 


(SEE 


SAME) * 














, X. 


SAME* 


XSMDEV 


(SEE 


SUMDFR). 














x. 


SUM DEEV* 


XSMDFR 


(SEE 


SUMDFR). 














X. 


SUM DIFFER* 


XSPECT 


• 
• 
• 
* 
• 
• 


SPLIT . 
COSISP . 
REFIT • 
XLOC 

KOLAPS . 
CHPRTS . 


523 . 


9/29/64 . 


239 . 


26 ! 


\ SMS \ 


F - 


X, 


• SPECT 



*«»•»«*»»*•••*»•«*•»•»*» 

* XSQDEV TO ZEFBIN • 
»»»»»*»•»#••»*»»»«**»*•• 



PROGRAM STATISTICS 



•*•••»•••••»••*•*•*•»••* 

* XSQDEV TO ZEFBIN * 
****»••••»«*••**** 4 •«*•# 



ZEFBIN . 



( IOS) 
(RDSI 
(RCH) 
(TCO) 
(TEF) 
( TRC ) 
{ BSR ) 



ZEFBIN (SEE ZEFBCD) 



XSQDEV 


(SEE 


XSQDFR). 






• 








► X. 


SKUH DEEV f 


XSQDFR 

XSQDEV . 


• 


37 \ 


9/29/64 ! 


113 \ 


3 ! 


\ SMS « 


M « 


> X. 


SKUH DIFFER 1 


XSQRUT 


• 

• 

• 


• 

FIXVR \ 
SQRT 


3T \ 


9/29/64 I 


103 I 
• 


3 \ 


! SMS ! 


M « 


! x. 


SKUH ROOT» 


XSQSUM 


(SEE 


SQRSUM). 






• 








> X. 


SKUH SUM* 


XSQUAR 


(SEE 


SQUARE 1 . 






* 








► X. 


SKWAHR 1 


XSTEPC 


• 

(SEE 


DELTA) \ 






• 








, X. 


STEP C.» 


XSTEPL 


(SEE 


DELTAI \ 






• 








> X. 


STEP L.« 


XSTEPR 


(SEE 


DELTA) \ 






• 








, X. 


STEP R.» 


XSTLIN 


(SEE 


SETLIN). 














► X. 


SET* LIN 


XSUBK 


(SEE 


ADDK) . 






• 








. X. 


SUB» K. 


XSUBKS 


(SEE 


ADDK) • 






• 








. X. 


SUB KAYZ* 


XSUM 


(SEE 


SUM) \ 






• 








> X. 


SUM* 


XVDRBV 


(SEE 


XVDVBV). 






• 








, X.V. § D.R.B.V.' 


• 

XVDVBV 

XVDRBV . 

• 


• 

XDIV \ 

vn IMQ 

AUl»l\ • 


34 . 


9/29/64 ! 


109 \ 
• 


3 , 


\ SMS ! 


. M \ 


, X.V.« D.V. f B.V. 1 


XVMNSV 


• 

(SEE 


VPLUSV). 














» X. 


V. 1 MINUS V.» 


XVPLSV 


(SEE 


VPLUSV)! 














, X. 


V.* PLUS V. f 


XVTMSV 


(SEE 


VTIMSV)! 














> X. 


V.* TIMES V.» 


XWHICH 


(SEE 


WHICH) . 














, X. 


WHICH 1 


ZEFBCD 


• 
• 




54 \ 


9/ 8/64 . 


129 \ 


4 « 


\ JNG « 


, M ! 


! ZEFF 1 B. C. D.« 



ZEFF* BIN* 



A One-Pass 
Subroutine Library 



A subroutine library in the FORTRAN Monitor System (FMS) is a magnetic tape file 
containing binary mode images of the column binary subprogram decks forming the 
library. It contains no table of contents, and this fact gives rise to the first* problem 
of library design, namely the problem of arranging routines in one-pass order. This 
term refers to the behavior of the FMS loading program, which, at the beginning of 
each execution, passes continuously through the library file gathering all subprograms 
required by, but missing from, the input deck, plus all additional subprograms required 
by those gathered. If the library is so arranged that for every program the loader can 
pick up, all of the lower-level programs are physically located deeper in the file, then 
all programs required for any execution are retrievable by the loader in one pass, or 
less, of the library. Otherwise the loader must return to the beginning of the file and 
start searching again. 

For example, if the library contains program A which requires program B, 
and B which requires program C, and C which has no requirements, then the 
order A,B,C is one-pass, whereas the order C,B,A is three-pass (in the event 
that the input deck refers only to program A). In this example note that if program C 
requires program A, one-passness can be realized only by using redundant copies, 
i.e., A,B,C,A. In a library the size of the present one, a single pass takes half a minute 
or more. Consequently the one-pass property is economically important. 

The second problem of library design is strategic arrangement, within the one- 
pass constraint, designed to minimize the average (over many executions) distance 
that the loader must penetrate the library file before its search is ended. The control- 
ling factors in this problem are the natures and frequencies of expected input deck 
requirements , the logical relationships between the programs in the library, and the 
physical lengths of these programs. As a general guide short programs and often used 
programs should appear early, seldom used and longer programs late in the library. 
However, since this rule will often be in conflict with the one-pass constraint, one 
resorts to sprinkling redundant copies of key programs throughout the library so as to 
expand the arrangement possibilities within the constraint. The redundancy must be 
limited, however, since by lengthening the entire library it tends to cancel its own 
benefits. 

The main portion of this section is made up of listings of a one-pass library, 
composed from the programs of Section 10 plus the standard FORTRAN System routines 



*Assuming that the more basic problem of completness is satisfied, i.e., no program 
in the library calls on any program not in the library. 



159 



Time-Series Computations in FORTRAN and FAP 



(including double precision and complex arithmetic routines) and arranged for mini- 
mizing average search time with respect to our usage experience. Where Section 10 
has more than one program of the same name the versions selected for the library are 
as follows. 



On library 
CONVLV-II 
DISPLA (7090) 
FRAME (7090) 
FT24 



HSTPLT 

LINE 
LINEH 
LINEV 
ADDK 

SETK 
SETK 



-II 

(7090) 
(7090) 
(7090) 

(which has MULK as 
a secondary entry) 



(which has SETKS as 
a secondary entry) 



Excluded 
CONVLV 
DISPLA (709) 
FRAME (709) 
FT24 

HSTPLT-II, HSTPLT-III (709), 
HSTPLT-III (7090) 



LINE 
LINEH 
LINEV 
MULK 

SETK 
SETKS 



(709) 
(709) 
(709) 
-II 

-II 
-II 



Consequently, the library is designed for the 7090 or 7094. The 7090 programs 
work on the 7094 and vice versa, except that TIMA2B (7094) must be modified as indi- 
cated in the listing of Section 10 to give correct results on the 7090. 

The modifications required by an adaptation of the library to the 709 consist of 
swapping the 709 and 7090 programs as in the above list and deleting the following 
programs (for which we have no 709 versions): 

CLOCK 1(7090), CLKON, TIMSUB, TIMA2B (7094). 

The library has 402 principal entries, of which 99 are redundant copies. The 
first table below lists these 402 entries in the order of their occurence in the library 
(their storage requirements and binary card counts are also given). Following this 
table is another giving an alphabetized ordering of the 402 principal entries with their 
corresponding index positions within the library. 

The following rule will enable one to distinguish FORTRAN System routines. 
A principle entry name is that of a FORTRAN System routine if either of the following 
is true. 

1. its first character is a left parenthesis, or 

2. it is from the following list of 27 routines. 



ATAN 

DINT 

EXIT 

IEXP 

SQRT 



CHAIN 
DLOG 
EXP 
IEXP (2 
TANH 



COS 

DMOD 

EXP(1 

ILOG 

XLOC 



DATAN 
DSIN 
EXP (2 
ISIN 



DEXP 
DSQRT 
EXP (3 
ISQRT 



DEXP(3 
DUMP 
IABS 
LOG 



160 



SUBROUTINE LIBRARY PRINCIPAL ENTRIES, STORAGE LENGTHS, BINARY CARD COUNTS 



1. 


(FPT) 


41 


4 


I 


56. 


XACTEQ 


11 


2 1 


[ 111. 


CARIGE 


47 


4 


2. 


C I OH) 


1016 


52 


I 


57. 


AODK 


114 


8 1 


[ 112. 


MAXSNM 


61 


5 


3. 


(IOS) 


87 


7 


I 


58. 


CHOOSE 


17 


2 1 


[ 113. 


GNH0L2 


74 


5 


4. 


(EXEM) 


458 


24 


I 


59. 


CMPRA 


18 


2 3 


E 114. 


CPYFL2 


178 


10 


5. 


( IOUI 


24 


3 


I 


60. 


DELTA 


17 


2 1 


[ 115. 


EXCHVS 


22 


3 


6. 


DUMP 


177 


7 


I 


61. 


INDEX 


50 


4 


I 116. 


MULPLY 


34 


3 


7. 


EXIT 


17 


2 


I 


62. 


LIMITS 


44 


4 J 


E 117. 


PLURNS 


73 


5 


8. 


(TES) 


1 


2 


I 


63. 


LSHFT 


12 


2 i 


E 118. 


SRCH1 


93 


6 


9. 


ONLINE 


134 


8 


I 


64. 


NTHA 


11 


2 1 


E 119. 


XACTEQ 


11 


2 


10. 


CSOUT 


49 


4 


I 


65. 


SETKP 


40 


3 1 


[ 120. 


AMPHZ 


149 


10 


11. 


CVSOUT 


84 


6 


I 


66. 


SETK 


37 


3 1 


[ 121. 


COS 


105 


7 


12. 


FMTQUT 


51 


4 


I 


67. 


SETKV 


15 


2 I 


t 122. 


ATAN 


77 


5 


13. 


REREAD 


114 


7 


I 


68. 


SETKVS 


25 


3 1 


E 123. 


GETHOL 


169 


9 


14. 


VRSOUT 


47 


4 


I 


69. 


SETLNS 


39 


3 I 


E 124. 


REVERS 


29 


3 


15. 


VSOUT 


37 


3 


I 


70. 


SETLIN 


27 


3 1 


E 125. 


MEMUSE 


71 


5 


16. 


VOUT 


104 


7 


I 


71. 


SWITCH 


15 


2 1 


I 126. 


XLCOMN 


14 


2 


17. 


CARIGE 


47 


4 


I 


72. 


WHICH 


4 


2 1 


E 127. 


(STH) 


83 


5 


18. 


VECOUT 


66 


5 


1 


73. 


XLIMIT 


25 


3 3 


E 128. 


(WER) 


57 


4 


19. 


RPLFMT 


17 


2 


I 


74. 


XOOZE 


4 


2 3 


[ 129. 


CRCST 


134 


8 


20. 


FNDFMT 


88 


6 


I 


75. 


DOTJ 


59 


4 3 


E 130. 


CROSS 


107 


7 


21. 


REVER 


30 


3 


I 


76. 


FIXV 


35 


3 3 


E 131. 


STZ 


14 


2 


22. 


HLADJ 


46 


4 


I 


77. 


FSKIP 


50 


4 3 


E 132. 


LSSS1 


122 


7 


23. 


(STH) 


83 


5 


I 


78. 


MATRA 


92 


6 3 


E 133. 


PLTVS1 


817 


40 


24. 


(STB) 


53 


4 


I 


79. 


MAXSN 


54 


5 3 


E 134. 


MULPLY 


34 


3 


25. 


(WER 1 


57 


4 


I 


80. 


XLCOMN 


14 


2 3 


E 135. 


MAXSN 


54 


5 


26. 


(TSB) 


66 


5 


I 


81. 


(SLI) 


13 


2 3 


E 136. 


SETLIN 


27 


3 


27. 


( RER ) 


37 


3 


I 


82. 


(SLO) 


13 


2 3 


E 137. 


SETKVS 


25 


3 


28. 


( I OB) 


570 


6 


I 


83. 


MOUT 


130 


8 3 


E 138. 


PLGTVS 


494 


18 


29. 


(BSTI 


28 


3 


I 


84. 


CARIGE 


47 


4 3 


E 139. 


SWITCH 


15 


2 


30. 


(CSH) 


125 


8 


I 


85. 


(STH) 


83 


5 3 


E 140. 


SETKV 


15 


2 


31. 


(EFT) 


7 


2 


I 


86. 


(WER) 


57 


4 3 


E 141. 


SETK 


37 


3 


32. 


(RWT) 


7 


2 


I 


87. 


GETX 


31 


3 3 


E 142. 


RND 


15 


2 


33. 


(SCH) 


96 


6 


I 


88. 


TIMSUB 


229 


13 3 


E 143. 


(SPHI 


183 


11 


34. 


IXCARG 


35 


3 


I 


89. 


TIMA2B 


124 


8 3 


E 144. 


BOOST 


34 


3 


35. 


XLOC 


12 


2 


I 


90. 


LOCATE 


512 


28 1 


E 145. 


RMSDEV 


50 


4 


36. 


CLKON 


46 


4 


I 


91. 


RDATA 


645 


31 3 


E 146. 


SQRT 


44 


4 


37. 


CL0CK1 


57 


4 


I 


92. 


CMPRA 


18 


2 J 


E 147. 


RLSPR 


142 


8 


38. 


(SPH) 


183 


11 


I 


93. 


IXCARG 


35 


3 3 


E 148. 


RLSSR 


82 


5 


39. 


RND 


15 


2 


I 


94. 


XLOC 


12 


2 J 


[ 149. 


SHUFFL 


101 


6 


40. 


SAME 


1 


2 


I 


95. 


REREAD 


114 


7 3 


i 150. 


SEARCH 


25 


3 


41. 


ARCTAN 


29 


3 


I 


96. 


( RER 1 


37 


3 3 


E 151. 


GETRD1 


229 


10 


42. 


ATAN 


77 


5 


I 


97. 


INTHOL 


72 


5 1 


E 152. 


REREAD 


114 


7 


43. 


COSTBL 


121 


8 


I 


98. 


FNDFMT 


88 


6 3 


E 153. 


(RER) 


37 


3 


44. 


COS 


105 


7 


I 


99. 


REVER 


30 


3 1 


E 154. 


SIZEUP 


136 


8 


45. 


EXP 


52 


4 


I 


100. 


HVTOIV 


39 


3 3 


[ 155. 


CMPARP 


53 


4 


46. 


EXP(1 


35 


3 


I 


101. 


IVTOHV 


70 


5 1 


E 156. 


FOOT 


40 


3 


47. 


EXP(2 


38 


3 


I 


102. 


DADECK 


100 


6 3 


E 157. 


IPLYEV 


98 


6 


48. 


EXP(3 


93 


6 


I 


103. 


RSKIP 


37 


3 3 


C 158. 


(IFMP) 


136 


8 


49. 


LOG 


53 


4 


I 


104. 


MOUTAI 


357 


18 3 


t 159. 


QACORR 


207 


11 


50. 


SORT 


44 


4 


I 


105. 


FIXV 


35 


3 3 


E 160. 


OCNVLV 


569 


27 


51. 


TANH 


86 


6 


I 


106. 


MOVE 


32 


3 3 


E 161. 


QXCORR 


283 


15 


52. 


MOVE 


32 


3 


I 


107. 


LOG 


53 


4 3 


E 162. 


SPC0R2 


291 


15 


53. 


MOVREV 


74 


5 


I 


108. 


EXP(2 


38 


3 3 


[ 163. 


QXC0R1 


502 


25 


54. 


REVERS 


29 


3 


I 


109. 


SAME 


1 


2 3 


E 164. 


REVERS 


29 


3 


55. 


STZ 


14 


2 


I 


110. 


RND 


15 


2 3 


E 165. 


IXCARG 


35 


3 



SUBROUTINE LIBRARY PRINCIPAL ENTRIES, STORAGE LENGTHSt BINARY CARD COUNTS 



166. 


XLOC 


12 


2 


I 


221. 


TAMVL 


63 


5 


I 


276. 


MATML3 


120 


7 


167 • 


PROCOR 


770 


40 


1 


727- 


TINGL 


43 


4 


I 


277. 


00TP 


264 


14 

x~ 


168. 


R0TAT1 


46 


4 


I 


223. 


V00TV 


25 


3 


I 


278. 


D0TJ 


59 


4 


169. 


STZS 


24 


3 


I 


224. 


V0VBYV 


22 


3 


I 


279. 


SIMEQ 


441 


24 


170 • 


ZEFBCD 


54 


4 




775. 

A A J * 


vr luoi 


34 


3 


1 


280. 


I0ER I V 


54 


4 


1 71 * 

X * X « 


FXOATA 


10? 




X 


776- 


VTIMSV 


34 


3 


r 

A 


781 - 

AO X . 


MP ACT 


1 87 

X O I 


10 
xu 


172 • 


IFNCTN 


208 


1 7 

X a 


1 


777- 

AA f . 


WLLSFP 


716 

C XO 


X X 


I 


282 . 


nfiT i 


5Q 

-J 7 


4 


173. 


REVER 


30 


3 


I 


228. 


FD0T 


40 


3 


I 


283. 


STZ 


14 


2 


174. 


MQNQCK 


48 


4 


I 


229. 


XDVIDE 


33 


3 


J 


284. 


SQRT 


44 


4 


175 • 


POLYDV 


130 


7 


1 


230. 


XRFMAV 

/\ r\ *» n W w 


31 


3 


I 


285. 


NUR INC 

iii ki r> & m v» 


121 


8 


176* 


STZ 


14 


2 


I 


231. 


XAVRGP 


34 


3 


I 


286. 


S IFT 


30 


3 


177 • 


POLYEV 


54 


4 


1 


232. 


XVDVBV 


34 


3 


| 


287. 


CNTRDB 


550 


27 


178- 
no* 


POLYSN 


256 


14 

X "r 


1 

A 


711- 


X0I V 


27 


3 


| 


288. 


SETK 


37 


3 


179. 


MOVE 


32 


3 


| 


234. 


XL0CV 


24 


3 


I 


289. 


EXP 


52 


4 




ABSVAL 


50 


4 


I 


715- 


XSOOFR 


37 


3 


I 


290. 


CONTUR 


587 


29 


1 81 - 
101 • 


AftAMl 

Ml/RINl, 


1 81 

X O J 


1 1 

X X 


f 
A 


716- 


YCQD1JT 


17 




f 
A 


791 - 

A 7 X . 


SW ITCH 


15 

X -* 


2 


1 87 




A*T 


1 


A 


717- 

CD f . 


F I XV 


15 


3 


f 
A 


292. 


C0LABL 


I 85 

X O 


10 


183 


DL INO vl"l 


4Q 


4 


I 
A 


718 


ASPECT 


778 


1 5 

X J 


I 
A 


791 - 

A7 J . 


fNTROU 

\* I N ilMJn 


802 


39 


1 ft4 


rue TfiM 

UnJl OfN 


1 ft 
XO 


o 
a 


f 
A 


71Q 


mi ap^ 

l/ULArO 




A 
*T 


T 
A 


7Q4 

A 7"t • 


ar nrm 


1 7Q 

X A 7 


o 

O 


1 ft5 






A 
"f 


f 
A 


740 - 

A "TV/ . 




45 


4 


f 
A 


79,5- 


ruF i t l 

v> v/ r a i x 


158 


9 


1 86 




56 

I/O 


A 
"T 


A 


741 
A"* x . 


P Af TOR 


1A8 


i 7 

X f 


I 
A 


296 . 


P A Cf lift 
• H O V V/O 


1 41 

X ~ X 


9 


1 ft 7 
JLO r • 


L/Crv A V M 


O X 


5 


f 
t 


747 

A*tA . 


MAY <vhi 
n f% a %> in 


54 


5 


I 
A 


7Q7 

C7 f • 


v>c iinut 


48 


4 


1 88 


ill FPR *s 


10 


3 


f 
A 


741 - 




53 


4 


I 


298. 


EXPAND 


1 89 


\\ 


1 8Q 


n 1 V T HP 


71 




f 

A 


744 


py p 

CAr 


57 


4 


f 
A 


799- 

A 77 . 


INT0PR 


111 

XXX 


7 


i on 


PI nATV 


77 
A A 




r 

A 


745 


PI AN<sP 
r L. « IN O r 


1 1 6Q 

X X07 


56 

PO 


A 


100- 


0 INTR1 

%| A R I l> X 


779 

A A7 


1 7 

X A 


1 Ql 

X 7 X * 


I T WTfifi 

1 I 1)1 1 OR 


4Q 


4 


r 

A 


746 
A "TO . 


xnn7P 

AUUt «_ 


4 


A 


f 
A 


101 - 
Jw x . 


RNO 


15 


2 


1 Q7 


TMTCOA 
1 IT 1 Ol\H 


47 


4 


I 


747- 

A~ 1 . 


SETK 


37 


3 


I 


302. 


QUFTT1 

WVl A I X 


79 


5 


193* 


I NT&UM 

A in i oun 


27 


3 


I 


248 • 


LIMITS 


44 


4 


J 


303. 


LISTNG 


755 


38 


194 • 


I TQML I 


37 


3 


I 


249. 


CHOOSE 


17 


2 


I 


304. 


FSKIP 


50 


4 


1 Q5 

X 7 J • 


MOOT 


i 09 


7 


T 
A 


750- 
A J v . 


A0DK 


114 


8 


I 


305. 


( SPHI 


183 


11 


1 Q6 
X /O • 


MATMt 1 


61 
O X 


5 


f 
A 


751 - 

A -J X « 


rns i si 

V» U O A OX 


406 


21 


I 


306. 


(RWT ) 


7 


2 


1 Q7 
x 7 f • 


mi i^ri 

riL. tout 


47 


4 


I 
A 


757- 

A A * 


R0AR2 


174 


9 


I 


307. 


( TSB ) 


66 


5 


198 • 


MOVECS 


24 


3 


J 


253. 


REVERS 


29 


3 


I 


308. 


( 1 0B) 


570 


6 


x 7 7 . 


MPSEQ1 


110 

X XV 


7 


I 
A 


254. 


MOVRPV 


74 


5 


I 


309. 


5HP7R2 


72 


5 


700 - 


MRVRS 


61 


4 


J 


255. 


QFURRY 


244 


13 


I 


310. 


TRMIN0 


67 


5 


7n i 


mi iv Ann 


1 79 

X £.7 


3 


f 
A 


756- 

A .JO . 


MflVF 


32 


3 


I 


311. 


0U0ATA 


495 


11 


7H7 

cue * 


MV I WAV 


771 

A A X 


1 7 

X A 


T 
A 


757- 
a-j i . 


YCppfT 


523 


26 


I 


312. 


( EFT) 


7 


2 


701 - 


MVNSUM 


71 


5 


J 


258. 


SPLIT 


224 


13 


I 


313. 


(STB ) 


53 


4 




MVNT T N 
n v in i a in 


88 


5 


A 


759- 

A~> 7 « 


KOI AP^ 


100 


6 


J 


314. 


PAKN 


78 


5 


705 


n v o v 


716 

A JO 


1 1 

X-> 


f 
X 


760- 


V* n r r\ • O 


76 


5 


I 


315. 


FXDATA 


102 


7 


">(\f\ 
CuO • 


MM 7 Mr: 1 






¥ 
A 


761 


0 f FtlRY 


780 


1 4 
x ^ 


I 


316. 


ASPEC2 


74 


5 


7A7 
Aw I • 


MBMVPT 
in i\ n v c v# 


111 

XXX 


7 


T 
X 


767 


v* U O I DL 


171 

X A X 


a 

o 


f 
A 


117- 


SEQSAC 


94 


5 


?nft 

two • 


MA X<tNI 

rlH AOIN 


54 


j> 


I 
A 


761- 


COS 


105 


7 


J 


318. 


INDATA 


896 


32 






5H 


A 

*T 


T 
A 


764 


wUOr 


504 


77 

A f 


f 
A 




<>AMF 


I 


2 




KCrLtli 


7ft 
AO 


J 


T 
1 


765 




177 

3 A f 


1 7 
x r 


I 
A 


170- 

J A V . 


11NPAKN 


78 


5 


711 


REMAV 


36 


3 


I 


266. 


F IRE2 


271 


14 


I 


321. 


SETIN0 


84 


6 


212. 


RNDV 


34 


3 


I 


267. 


MIFLS 


276 


14 


I 


322. 


FSKIP 


50 


4 


213. 


SHFTR1 


70 


5 


I 


268. 


MIPLS 


571 


28 


I 


323. 


XLIMIT 


25 


3 


214. 


SQRDFR 


36 


3 


I 


269. 


MATRA 


92 


6 


I 


324. 


(RWT) 


7 


2 


215. 


SQRMLI 


55 


4 


I 


270. 


MATINV 


90 


6 


I 


325. 


(TSB) 


66 


5 


216. 


SQR00T 


24 


3 


I 


271. 


MISS 


335 


17 


I 


326. 


(I0B) 


570 


6 


217. 


SQRSUM 


36 


3 


I 


272. 


MD0T3 


122 


7 


I 


327. 


(RER) 


37 


3 


218. 


SQUARE 


32 


3 


I 


273. 


RLSPR2 


700 


34 


I 


328. 


FAPSUM 


14 


2 


219. 


SUM 


23 


3 


I 


274. 


M0VREV 


74 


5 


I 


329. 


KIINT1 


191 


10 


220. 


SUMDFR 


44 


4 


I 


275. 


IXCARG 


35 


3 


I 


330. 


EXPO 


93 


6 



SUBROUTINE LIBRARY PRINCIPAL ENTRIES, STORAGE LENGTHS, BINARY CARD COUNTS 



331. NOINT1 369 20 

332. LINTR1 96 6 

333. LOC 4 2 

334. MVBLOK 19 2 

335. VARARG 44 4 

336. GRAPHX 123 7 

337. GRAPH 1499 72 

338. MVBLOK 19 2 

339. LOG 53 4 

340. EXP{2 38 3 

341. XLOC 12 2 

342. DISPLA 219 13 

343. OSPFMT 194 11 

344. FLOATM 25 3 

345. FRAME 9 2 

346. HSTPLT 145 9 

347. LINE 95 6 

348. LINEH 35 3 

349. LINEV 35 3 

350. SCPSCL 33 3 

351. XFIXM 31 3 

352. MULLER 757 36 

353. CHISQR 105 6 

354. FASTRK 26 3 

355. FRQCT2 117 7 

356. GNFLT1 232 12 

357. GRUP2 201 11 

358. LSLINE 117 7 

359. MATRA1 42 4 

360. MSC0N1 238 11 

361. PACOAT 152 9 

362. P0KCT1 219 11 

363. FRQCT1 117 7 

364. PRBFIT 373 16 

365. EXP 52 4 

366. PR0B2 229 12 

367. WAC 107 6 

368. WRTDAT 77 5 

369. PWMLIV 300 15 

370. CSPH) 183 11 

371. ( STH ) 83 5 

372. <WER) 57 4 

373. MLI2A6 128 8 

374. SMPSON 317 17 

375. FT24 818 39 

376. MXRARE 302 16 

377. EXPC2 38 3 

378. NXALRM 243 13 

379. FASCN1 107 7 

380. SEVRAL 416 22 

381. LOCATE 512 28 

382. CHAIN 179 10 

383. IABS 21 3 

384. IEXP 157 9 

385. IEXP<2 161 9 



386. 


ILOG 


190 


11 


I 


387. 


ISIN 


184 


11 


I 


388. 


ISQRT 


88 


6 


I 


389. 


(DFAO) 


80 


5 


I 


390. 


OATAN 


440 


24 


I 


391. 


DEXPC3 


34 


3 


I 


392. 


OEXP 


153 


9 


I 


393. 


OLOG 


273 


15 


I 


394. 


DINT 


10 


2 


I 


395. 


DMOO 


48 


4 


I 


396. 


OSIN 


222 


13 


I 


397. 


DSQRT 


66 


5 


I 


398. 


PLYSYN 


172 


10 


I 


399. 


CONVLV 


56 


4 


I 


400. 


COS 


105 


7 


I 


401. 


PSQRT 


155 


9 


I 


402. 


SQRT 


44 


4 


I 



SUBROUTINE LIBRARY PRINCIPAL ENTRIES ALPHABET IZEOt WITH ENTRY INDICES 



(8ST) 29 I 

(CSH) 30 I 

(DFAD) 389 I 

(EFT) 312 I 

(EFT) 31 I 

( EXEM) 4 I 

(FPT) 1 I 

CIFMP) 158 I 

(IOB) 326 I 

(IOBI 308 I 

(IOB) 28 I 

UQH) 2 I 

UOS) 3 I 

(IOU) 5 I 

(RER) 96 I 

(RER) 153 I 

(RER) 327 I 

(RER) 27 I 

(RWT) 32 I 

(RWT ) 306 I 

(RWT) 324 I 

(SCHI 33 I 

(SLI) 81 I 

(SLO) 82 I 

(SPH) 38 I 

(SPH) 370 I 

(SPH) 305 I 

(SPH) 143 I 

(STB) 24 I 

(STB) 313 I 

( STH ) 371 I 

(STH) 127 I 

(STH) 85 I 

(STH) 23 I 

(TES) 8 I 

(TSB) 307 I 

( TSB) 26 I 

(TSB) 325 I 

(WER) 128 I 

(WER) 372 I 

(WER) 25 I 

(WER) 86 I 

ABSVAL 180 I 

ADANL 181 I 

ADOK 250 I 

ADDK 57 I 

AMPHZ 120 I 

ARBCOL 294 I 

ARCTAN 41 I 

ASPECT 238 I 

ASPEC2 316 I 

ATAN 42 I 

ATAN 122 I 

AVRAGE 182 I 

BLKSUM 183 I 



BOOST 


144 


I 


CARIGE 


17 


I 


CARIGE 


111 


I 


CARIGE 


84 


I 


CHAIN 


382 


I 


CHISQR 


353 


I 


CHOOSE 


249 


I 


CHOOSE 


58 


I 


CHPRTS 


260 


I 


CHSIGN 


184 


I 


CLKON 


36 


I 


CL0CK1 


37 


I 


CMPARP 


155 


I 


CMPARV 


185 


I 


CMPRA 


92 


I 


CMPRA 


59 


I 


CNTROB 


287 


I 


CNTROW 


293 


I 


COLABL 


292 


I 


COLAPS 


239 


I 


CONTUR 


290 


I 


CONVLV 


399 


I 


CONVLV 


186 


I 


COS 


263 


I 


COS 


121 


I 


COS 


400 


I 


COS 


44 


I 


C0SIS1 


251 


I 


COSP 


264 


I 


COSTBL 


43 


I 


COSTBL 


262 


I 


CPYFL2 


114 


I 


CROSS 


130 


I 


CROST 


129 


I 


CRSVM 


265 


I 


CSOUT 


10 


I 


CUFIT1 


295 


I 


CVSOUT 


11 


I 


OAOECK 


102 


I 


DATAN 


390 


I 


DELTA 


60 


I 


DERIVA 


187 


I 


DEXP 


392 


I 


DEXP(3 


391 


I 


DIFPRS 


188 


I 


DINT 


394 


I 


DISPLA 


342 


I 


DIVIDE 


189 


I 


DLOG 


393 


I 


DMOD 


395 


I 


DOTJ 


75 


I 


DOTJ 


278 


I 


DOTJ 


282 


I 


DOTP 


277 


I 


DSIN 


396 


I 



DSPFMT 


343 


I 


DSQRT 


397 


I 


DU8LX 


240 


I 


DUMP 


6 


I 


EXCHVS 


115 


I 


EXIT 


7 


I 


EXP 


45 


I 


EXP 


289 


I 


EXP 


365 


I 


EXP 


244 


I 


EXP(1 


46 


I 


EXP(2 


340 


I 


EXPI2 


377 


I 


EXP(2 


108 


I 


EXP(2 


47 


I 


EXP(3 


330 


I 


EXP(3 


48 


I 


EXPAND 


298 


I 


FACTOR 


241 


I 


FAPSUM 


328 


I 


FASCN1 


379 


I 


FASCUB 


296 


I 


FASTRK 


354 


I 


FOOT 


156 


I 


FOOT 


228 


I 


FIRE2 


266 


I 


FIXV 


105 


I 


FIXV 


76 


I 


FIXV 


237 


I 


FLOATM 


344 


I 


FLOATV 


190 


I 


FMTOUT 


12 


I 


FNDFMT 


98 


I 


FNDFMT 


20 


I 


FRAME 


345 


I 


FRQCT1 


363 


I 


FR0CT2 


355 


I 


FSKIP 


322 


I 


FSKIP 


77 


I 


FSKIP 


304 


I 


FT24 


375 


I 


FXDATA 


315 


I 


FXDATA 


171 


I 


GENHOL 


297 


I 


GETHOL 


123 


I 


GETRD1 


151 


I 


GETX 


87 


I 


GNFLT1 


356 


I 


GNH0L2 


113 


I 


GRAPH 


337 


I 


GRAPHX 


336 


I 


GRUP2 


357 


I 


HLADJ 


22 


I 


HSTPLT 


346 


I 


HVTOIV 


100 


I 



IABS 


383 


I 


IDERIV 


280 


I 


IEXP 


384 


I 


IEXP(2 


385 


I 


IFNCTN 


172 


I 


IINTGR 


191 


I 


I LOG 


386 


I 


INDATA 


318 


I 


INDEX 


61 


I 


INTGRA 


192 


I 


INTHOL 


97 


I 


INTOPR 


299 


I 


INTSUM 


193 


I 


IPLYEV 


157 


I 


1 5 IN 


387 


I 


ISQRT 


388 


I 


ITOMLI 


194 


I 


IVTOHV 


101 


I 


IXCARG 


275 


I 


IXCARG 


165 


I 


IXCARG 


93 


I 


IXCARG 


34 


I 


KIINT1 


329 


I 


KOLAPS 


259 


I 


LIMITS 


62 


I 


LIMITS 


248 


I 


LINE 


347 


I 


LINEH 


348 


I 


LINEV 


349 


I 


LINTR1 


332 


I 


LISTNG 


303 


I 


LOC 


333 


I 


LOCATE 


90 


I 


LOCATE 


381 


I 


LOG 


243 


I 


LOG 


107 


I 


LOG 


49 


I 


LOG 


339 


I 


LSHFT 


63 


I 


LSLINE 


358 


I 


LSSS1 


132 


I 


MATINV 


270 


I 


MATML1 


196 


I 


MATML3 


276 


I 


MATRA 


269 


I 


MATRA 


78 


I 


MATRA1 


359 


I 


MAXSN 


135 


I 


MAXSN 


242 


I 


MAXSN 


79 


I 


MAXSN 


208 




MAXSNM 


112 


I 


MDOT 


195 


I 


MD0T3 


272 


I 


MEMUSE 


125 


I 



MFACT 


281 


I 


MIFLS 


267 


I 


MIPLS 


268 


I 


MISS 


271 


I 


MLISCL 


197 


I 


MLI2A6 


373 


I 


MONCCK 


174 


I 


MOUT 


83 


I 


MOUTAI 


104 


I 


MOVE 


52 


I 


MOVE 


106 


I 


MOVE 


179 


I 


MOVE 


256 


I 


MOVECS 


198 


I 


MOVREV 


274 


I 


MOVREV 


53 


I 


MOVREV 


254 


I 


MPSEQ1 


199 


I 


MRVRS 


200 


I 


MSCCNi 


360 


I 


MULLER 


352 


I 


MULPLY 


134 


I 


MULPLY 


116 


I 


MUVAOD 


201 


I 


MVBLOK 


338 


I 


MVBLOK 


334 


I 


MVINAV 


202 


I 


MVNSUM 


203 


I 


MVNTIN 


204 


I 


MVSQAV 


205 


I 


MXRARE 


376 


I 


NMZMG1 


206 


I 


N0INT1 


331 


I 


NRMVEC 


207 


I 


NTHA 


64 


I 


NURINC 


285 


I 


NXALRM 


378 


I 


ONLINE 


9 


I 


OUDATA 


311 


I 


PACDAT 


361 


I 


PAKN 


314 


I 


PLANSP 


245 


I 


PLOTVS 


138 


I 


PLTVS1 


133 


I 


PLURNS 


117 


I 


PLYSYN 


398 


I 


P0KCT1 


362 


I 


POLYDV 


175 


I 


POLYEV 


177 


I 


POLYSN 


178 


I 


POWER 


209 


I 


PRBFIT 


364 


I 


PR0B2 


366 


I 


PROCOR 


167 


I 


PSQRT 


401 


I 
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PWML I V 


369 


I 


QACORR 


159 


I 


QCNVLV 


160 


I 


QFURRY 


255 


I 


QIFURY 


261 


I 


QINTR1 


300 


I 


QUF IT1 


302 


I 


QXCORR 


161 


I 


QXCOR1 


163 


I 


ROATA 


91 


I 


REFLEC 


210 


I 


REMAV 


211 


I 


REREAD 


95 


I 


REREAD 


13 


I 


REREAD 


152 


I 


REVER 


21 


I 


REVER 


173 


I 


REVER 


99 


I 


REVERS 


54 


I 


REVERS 


253 


I 


REVERS 


164 


I 


REVERS 


124 


| 


RLSPR 


147 


I 


RLSPR2 


273 


I 


RLSSR 


148 


I 


RHSDEV 


145 


I 


RND 


110 


I 


RND 


142 


I 


RND 


301 


I 


RND 


39 


I 


RNDV 


212 


I 


ROAR2 


252 


I 


ROTAT1 


168 


I 


RPLFMT 


19 


I 


RSKIP 


103 


I 


SAME 


319 


I 


SAME 


109 


I 


SANE 


40 


I 


SCPSCL 


350 


I 


SEARCH 


150 


I 


SEQSAC 


317 


I 


SET INO 


321 


I 


SETK 


66 


I 


SETK 


288 


I 


SETK 


247 


I 


SETK 


141 


I 


SETKP 


65 


I 


SETKV 


140 


I 


SETKV 


67 


I 


SETKVS 


137 


I 


SETKVS 


68 


I 


SETLIN 


70 


I 


SETLIN 


136 


I 


SETLNS 


69 


I 


SEVRAL 


380 


I 



SHFTR1 


213 


I 


SHFTR2 


309 


I 


SHUFFL 


149 


I 


SIFT 


286 


I 


SIMEQ 


279 


I 


S IZEUP 


154 


I 


SMPSON 


374 


f 


SPC0R2 


162 


I 


SPLIT 


258 


I 


SQRDFR 


214 


I 


SQRNLI 


215 


I 


SQROOT 


216 


I 


SQRSUM 


217 


I 


SQRT 


284 


I 


SQRT 


146 


I 


SQRT 


402 


I 


SQRT 


50 


I 


SQUARE 


218 


I 


SRCH1 


118 


I 


STZ 


131 


I 


STZ 


55 


I 


STZ 


283 


I 


STZ 


176 


I 


STZS 


169 


I 


SUM 


219 


I 


SUMDFR 


220 


I 


SWITCH 


71 


I 


SWITCH 


139 


I 


SW I TCH 


291 


I 


TAMVL 


221 


I 


TANH 


51 


I 


T IMA2B 


89 


I 


TIMSUB 


88 


I 


T INGL 


222 


I 


TRMINO 


310 


I 


UNPAKNI 


320 


| 


VARAR& 


335 


I 


VDOTV 


223 


I 


VDVBYV 


224 


I 


VECOUT 


18 


I 


VGUT 


16 


I 


VPLUSV 


225 


I 


VRSOUT 


14 


I 


VSOUT 


15 


I 


VT IMSV 


226 


I 


WAC 


367 


I 


WHICH 


72 


I 


WLLSFP 


227 


I 


WRTDAT 


368 


I 


XACTEQ 


119 


I 


XACTEQ 


56 


I 


XAVRGE 


231 


I 


XDIV 


233 


I 


XOVIDE 


229 


I 


XFIXM 


351 


I 



XLCOMN 


80 


I 


XLCOMN 


126 


I 


XLIMIT 


323 


I 


XLIMI T 


73 


I 


XLOC 


94 


I 


XLOC 


35 


I 


XLOC 


166 


I 


XLOC 


341 


I 


XLOCV 


234 


I 


XOOZE 


74 


I 


XOOZE 


246 


I 


XREMAV 


230 


I 


XSPECT 


257 


I 


XSQDFR 


235 


I 


XSQRUT 


236 


I 


XVDVBV 


232 


I 


ZEFBCD 


170 


I 



8 

Cross-Reference 
Table for 

the One-Pass Library 



Certain useful tabulations concerning linkage relationships are possible with respect 
to a complete and self -consistent library such as that given in Section 7 which are not 
possible with respect to the program set of Section 10. (The program set of Section 10 
is incomplete because it excludes FORTRAN System routines, and it is ambiguous 
from the standpoint of linkage because name duplication exists.) 

The linkage environment of an isolated program in a library complex has two 
directions. In one (upward), the program is called upon by a specific set of higher- 
level programs; in the other (downward) it requires a certain set of lower-level 
routines for the performance of its functions. In the present section we present a 
tabulation of the first layer of higher-level routines which call a given entry. Section 9 
gives the complete environment in the other direction (the first layer of lower routines 
being essentially synonymous with the transfer vector). 

The tabulations of the routines are alphabetically ordered by entry names. All 
entries, both principal and secondary, are included. The terminologies used in con- 
nection with names of secondary entries, with names of principal entries which have 
no secondary entries, and with names of principal entries which do have secondary 
entries all differ slightly. For secondary entries the format is 

A or B is called by C, D, . . . 

or 

A or B is not called by any programs in this set 

where 

A is the name of a secondary entry, 

B is the name of its associated principal entry, 

C, D, ... is a list of all principal entries which contain the name A in their 
transfer vectors 

For principal entries which have no secondary entries the format is 
A is called directly by C, D, . . . 

or 

A is not called by any programs in this set 
where C, D, . . . is as above. 
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Cross-Reference Table for the One-Pass Library 

For principal entries which have secondary entries two statements are made, 
one concerning the use of the principal entry name itself, in format 

A is called directly by C, D, . . . 

or 

A A is not called directly by any programs in this set 
and the other concerning the secondary entries, in format 
is called indirectly by X, Y, . . . 

or 

is not called directly or indirectly by any programs in this set, 

where 

X, Y, ... is a complete list of all principal entry names, each of whose 
transfer vectors contains one or more of the names of the sec- 
ondary entries of A. 
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»**»**•##*•*»*»•»*•*»»•» 

* (BSR) TO (IOH) » 
***»****«***»**•»»*•**•* 



SUBROUTINE 
CROSS-REFERENCE TABLE 



*»••»»•«•»•••••*«••»•••• 

* (BSR ) TC (IOH) * 
»•»*»»»•«•*«•••••••«•••• 



( BSR) , OF (IOS), IS CALLED BY (BST), (EXEM), CRER), (WER), CPYFL2, FSKIP, 

RSKIP, ZEFBCD. 

( BST) IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

(BUF) , OF (IOB), IS CALLED BY (TSB). 

(CSH) IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

(DFAD) IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 
(DFDP), OF (DFAD), IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
(DFMP), OF (DFAD), IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
( DFSBI t OF (DFAD), IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
(EFT) IS CALLED DIRECTLY BY OUDATA. 

(ETTI , OF (IOS), IS CALLED BY (WER), CPYFL2, PACDAT, WRTDAT. 
( EXB ) , OF (IOB), IS CALLED BY (STB), (TSB). 

(EXE) , OF (EXEM), IS CALLED BY (CSH), (FPT), (IOH), (IOS), (RER), (TSB), 

(WER), DEXP, DLOG, DSQRT. 

(EXEM) IS NOT CALLED DIRECTLY BY ANY PROGRAMS IN THIS SET. 

IS CALLED INDIRECTLY BY (CSH), (FPT), (IOH), (IOS), (RER), (TSB), 

(WER), DEXP, DLOG, DSQRT. 

(FID , OF (IOH), IS CALLED BY CARIGE, CLKON, CNTRDB, COLABL, CONTUR, CSOUT, 

DADECK, FMTOUT, GNHOL2, GRAPH, INDATA, LISTNG, 

MEMUSE, MOUT, MOUTAI, ONLINE, PLCTVS, PLTVS1, 

PWMLIV, RDATA, VECOUT, VOUT. 

(FPT) IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

(IFDP), OF (IFMP), IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

(IFMP) IS CALLED DIRECTLY BY IPLYEV. 

IS NOT CALLED INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

(IOB) IS CALLED DIRECTLY BY (STB), (TSB). 

IS CALLED INDIRECTLY BY (STB), (TSB). 

(IOH) IS CALLED DIRECTLY BY (CSH), (FPT), (SCH), (SPH), (STH), DISPLA, 

GENHOL, GNHOL2, INTHOL, ONLINE, REREAD. 

IS CALLED INDIRECTLY BY CARIGE, CLKON, CNTRDB, COLABL, CONTUR, CSOUT, 

DADECK, FMTOUT, GETRD1, GNHOL2, GRAPH, INDATA, 

INTHOL, LISTNG, MEMUSE , MOUT, MOUTAI, ONLINE , 

PLOTVS, PLTVS1, PWMLIV, RDATA, VECOUT, VOUT. 



»*»•»**»»»*»••*»**»*•*»* 

* (IOS) TO (STHM) * 
•»•****»•****«••»•••*••• 



SUBROUTINE 
CROSS-REFERENCE TABLE 



*»»»*»»»#»»#»»»»»»#»»»»* 

* (IOS) TO (STHM) ♦ 
•***»#»•*»•••**••*»•*«•• 



( IOS) 


IS 




IS 


CIOUI 


IS 


(RCHI 


t OF 


(RDC) 


t OF 


(RDS1 


t OF 


(RER) 


IS 




IS 


(KEW) 


t OF 


(RLR) 


t OF 


(RTN) 


t OF 


(RWT) 


IS 


(SCH) 


IS 


( SET 1 


, OF 


(SLI) 


IS 1 


(SLOI 


IS i 


(SPH) 


IS i 


(STB) 


IS i 




IS i 


(STH) 


IS < 




IS i 


(STHD) 


t OF 



IS CALLED DIRECTLY BY 



(BST), C EFT) t (EXEM), UOB), 

CPYFL2, FSKIP, PACDAT, RSKIP, 

CBST), (CSH), (EFT), (EXEM), 

ISCH), (SPH), (STB), ( SFH ) , 

CPYFL2, FSKIP, ONLINE, PACDAT, 

WRTDAT, ZEFBCD, 

(IOS). 



(IOH), (RWT), 

WRTDAT, ZEFBCD. 

(RER), | RWT ) , 

( TSB) , jWER), 

REREAD, RSKIP, 



(SPH), (STB), 
ONLINE, PACDAT, 



(IOS), IS CALLED BY (BST), (CSH), (RER), (SCH), 

(STH), (TSB), (WER), CPYFL2, 
REREAD, WRTDAT, ZEFBCD. 

, OF (RER), IS CALLED BY (TSB), REREAD. 

(IOS), IS CALLED BY (BST), (CSH), (RER), (TSB), CPYFL2, FSKIP, 
PACDAT, REREAD, RSKIP, ZEFBCD. 

tLLED DIRECTLY BY (TSB), REREAD. 

U.LED INDIRECTLY BY (TSB), REREAD. 



(TSB), IS CALLED BY INDATA, LISTNG, SETINO. 

(IOH), IS CALLED BY DADECK, GETRD1, INTHOL, RCATA. 
U.LED DIRECTLY BY LISTNG, SETINO, TRMINO. 
)T CALLED BY ANY PROGRAMS IN THIS SET. 

(IOB), IS CALLED BY (TSB). 



IS CALLED DIRECTLY BY 



CLKON, COLABL, CONTUR, GRAPH, 
ONLINE, PLOTVS, PWMLIV. 

OUDATA. 



CAR IGE, CNTRDB, COLABL, CONTUR, 
FMTOUT, INDATA, LISTNG, MEMUSE, 
PLOTVS, PLTVS1, PWMLIV, RDATA, 



INDATA, LISTNG, 



CSOUT, DADECK, 
MOUT, MOUTAI, 
VECOUT, VOUT. 



(STH), IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 



(STHM), OF (STH), IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 



••••*»»»•#•»*•»»»»*•***• 

* (TCO) TO ASPEC2 » 
*»*••»»»•**»*•*•*»»«*•»• 



SUBROUTINE 
CROSS-REFERENCE TABLE 



•»•*•»•«••*••****•*«**•* 

• (TCO) TO ASPEC2 * 
*»••»••«*«•••*•*»•*•#«•• 



(TCO) , OF (IOS), IS CALLED 8Y (BST), (CSH), CRER), (SCH), (SPH), (WER), 

CPYFL2, FSKIP, PACDAT, REREAO, RSKIP, WRTDAT, 
ZEF8C0. 

(TEF) , OF (IOS), IS CALLEO BY (BST), (CSH), ( RER) , FSKIP, REREAD, RSKIP, 

ZEFBCD. 

(TESI IS CALLED DIRECTLY BY (IOS), (STBI, (STH), (WER), CHAIN, DUMP, 

EXIT, ONLINE. 

( TRC ) , OF (IOS), IS CALLED BY CBSTI, (RERI, (WERI, CPYFL2, FSKIP, RSKIP, 

WRTDAT, ZEFBCD* 

( TSB) IS CALLED DIRECTLY BY INDATA, LISTNG, SETINO. 

IS CALLED INDIRECTLY BY INDATA, LISTNG, SETINO. 

(TSH) , OF REREAD, IS CALLED BY DADECK, GETRD1, RDATA. 

(TSHM), OF REREAD, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

(WEF) , OF (IOS), IS CALLED BY (EFT), (WER), CPYFL2. 

(WER) IS CALLED DIRECTLY BY {STBI, (STHI, ONLINE. 

IS CALLED INDIRECTLY BY (STB), (STH), ONLINE. 

(WLR) , OF (STB), IS CALLED BY OUDATA. 

(WRSI , OF (IOS), IS CALLED BY (SCH), (SPH), (STB), (STHI, (WER), CPYFL2, 

ONLINE, WRTDAT. 

(WTO , OF (WER), IS CALLED BY (STB), (STH), ONLINE. 

ABSVAL IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

ADANL IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

ADANX , OF ADANL, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

ADDK IS NOT CALLED DIRECTLY BY ANY PROGRAMS IN THIS SET. 
IS CALLED INDIRECTLY BY PLANSP. 

ADDKS , OF ADDK, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

AMPHZ IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

ARBCOL IS CALLED DIRECTLY BY CONTUR. 

ARCTAN IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

ARG , OF LOCATE, IS CALLED BY RDATA. 

ASPECT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

ASPEC2 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 



*#*•*»••*»••»•••*•«•*••• 

» ATAN TO CONVLV * 
••»*»••*»»*»•*••»••••*•• 



SUBROUTINE 
CROSS-REFERENCE TABLE 



•»*•»••••••*»«•*•••#••*'• 

♦ ATAN TO CONVLV « 
*»»«*•»•»•»•••«•*•*••«•* 



ATAN IS CALLED DIRECTLY 8Y AMPHZ, ARCTAN. 

AVRAGE IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

BLKSUM IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

BOOST IS CALLED DIRECTLY BY PLTVS1. 

IS CALLED INDIRECTLY BY PLTVS1. 

CALL , OF LOCATE, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CALL2 , OF LOCATE, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CARIGE IS CALLED DIRECTLY BY CSOUT, CVSOUT, MOUT, MOUTAI, VOUT, VRSOUT. 

CHAIN IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CHISQR IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CHOOSE IS CALLED DIRECTLY BY PLANSP. 

CHPRTS IS CALLED DIRECTLY BY COSIS1, XSPECT. 
IS CALLED INDIRECTLY BY ASPECT. 

CHSIGN IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CHUSET, OF INDEX, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CLKON IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CLOCK1 IS CALLED DIRECTLY BY CLKON. 

CMPARL, OF CMPARV, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CMPARP IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

CMPARS, OF CMPARP, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CMPARV IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

CMPRA IS CALLED DIRECTLY BY RDATA. 

IS NOT CALLED INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

CMPRFL, OF CMPRA, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CNTRDB IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CNTROW IS CALLED DIRECTLY BY CONTUR. 

COLABL IS CALLED DIRECTLY BY CONTUR. 

COLAPS IS CALLED DIRECTLY BY ASPECT. 

CONTUR IS CALLED DIRECTLY BY CNTRDB. 

CONVLV IS CALLED DIRECTLY BY PLYSYN, POLYSN. 



••*»•••«**•»••*•*»**•«»* 

* COS TO DIVIDE * 

•»**•»•*»••*••*»»*»••••* 



SUBROUTINE 
CROSS-REFERENCE TABLE 



#»»**»#»»*»»»»»«»###»»•» 

• COS TO DIVIDE • 

• »»*••••»***«*•'!«•*•«•«•• 



COS IS CALLED DIRECTLY BY AMPHZ, COSTBL, 6NFLT1 , PLYSYN, POLYSN, SEGSAC. 

IS CALLED INDIRECTLY BY ADANL, AMPHZ, COSTBL, SEQSAC. 

COSISP, OF COSP, IS CALLED BY COSISi, QIFURY, XSPECT. 

COSIS1 IS CALLED DIRECTLY BY PLANSP. 

COSP IS CALLED DIRECTLY BY ASPECT, COSISI, FACTOR. 

IS CALLED INDIRECTLY BY COSISI, QIFURY, XSPECT. 

COSTBL IS CALLED DIRECTLY BY FACTOR, PLANSP, QFURRY, QIFURY. 
IS CALLED INDIRECTLY BY PLANSP, QFURRY, QIFURY. 

COSTBX, OF COSTBL, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CPYFL2 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CROSS IS CALLED DIRECTLY BY CROST. 

CROST IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CRSVM IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CSOUT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

CUFIT1 IS CALLED DIRECTLY BY CNTROW. 

CVSOUT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

DADECK IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

DATAN IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

DATAN2, OF DATAN, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

DCOS , OF DSIN, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

DELTA IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

DERIVA IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

DETRM , OF SIMEQ, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

DEXP IS CALLEO DIRECTLY BY DEXPC3. 

DEXP(2, OF IEXPC2, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
DEXPO IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

DIFPRS IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

DINT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

DISPLA IS CALLED DIRECTLY BY GRAPH. 

DIVIDE IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 



»»•••»»»•»»*•••»*••*•••* 

* DIVK TO FASCN1 » 
•***«*•••#•»•»•••*«••#•» 
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»•**••««••••••*.*•••*••*# 

♦ DIVK TO FASCN1 * 
••*•*•«•*••*••*••««•*«•• 



DIVK , OF A DDK, IS NOT CALLED BY ANY PROGRAMS IN THIS SET* 

DIVKS , OF ADDKt IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

DLOG IS CALLED DIRECTLY BY DEXPI3. 

IS NOT CALLED INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

DLOGlDt OF DLOG, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

DMOD IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

DOTJ IS CALLED DIRECTLY BY DOTP, FIRE2, MATML3, MFACT, RLSPR2. 

DOTP IS CALLED DIRECTLY BY FIRE2, RLSPR2. 

DPRESS, OF BOOST, IS CALLED BY PLTVS1. 

DSIN IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

DSPFMT IS CALLED DIRECTLY BY GRAPH. 

DSQRT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

DUBLL , OF DUBLXt IS CALLED BY ASPECT. 

DUBLX IS CALLED DIRECTLY BY ASPECT. 

IS CALLED INDIRECTLY BY ASPECT. 

DUMP IS NOT CALLED DIRECTLY BY ANY PROGRAMS IN THIS SET. 
IS CALLED INDIRECTLY BY { EXEM ) • 

ENDFIL, OF REREAD, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

EOFSET, OF REREAD, IS CALLED BY DAOECK. 

EXCHVS IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

EXEDMP, OF { EXEM> , IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

EXIT IS CALLED DIRECTLY BY CHAIN, DUMP, REREAD. 

EXP IS CALLED DIRECTLY BY CNTRDB, FACTOR, PRBFIT. 

EXPU IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

EXP(2 IS CALLED DIRECTLY BY GRAPH, MOUTAI, MXRARE, POWER, PRBFIT. 

EXPO IS CALLED DIRECTLY BY KIINTl. 

EXPAND IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

FACTOR IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

FAPSUM IS CALLED DIRECTLY BY INDATA, LISTNG, OUDATA. 

FASCN1 IS CALLED DIRECTLY BY NXALRM. 



•»•»*•»«*#*»**••»»»«»••» 

* FASCOR TO GNFLTl * 
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*••»*»»*•»»»•»»*••••»«•* 

• FASCOR TO GNFLTl * 
*»**»*»««•••*••»••*««•*« 



FASCOR, OF PROCOR, IS CALLED BY QACORRf QCNVLV, QXCORR. 

FASCR1, OF PROCOR, IS CALLEO BY QXCOR1. 

FASCUB IS CALLED DIRECTLY BY CNTROW. 

FASEPC, OF PROCOR, IS CALLED BY QCNVLV. 

FASEPl, OF PROCOR, IS CALLED BY QXCOR1. 

FASTRK IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

FOOT IS CALLED DIRECTLY BY CROSS, LSSS1, VfLLSFP. 

IS CALLED INDIRECTLY BY RLSPR, RLSSR, WLLSFP. 

FDOTR , OF FDOT, IS CALLED BY RLSPR, RLSSR, WLLSFP. 

FIRE2 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

FIXV IS NOT CALLED DIRECTLY BY ANY PROGRAMS IN THIS SET. 
IS CALLED INDIRECTLY BY MOUTAI, XSQRUT. 

FIXVR , OF FIXV, IS CALLED BY MOUTAI, XSQRUT. 

FLDATA, OF FXDATA, IS CALLED BY QACORR, QCNVLV, QXCORR, SPCOR2. 



FLOATM 


IS 


CALLED DIRECTLY BY GRAPH. 




FLOATV 


IS 


NOT CALLED BY ANY PROGRAMS IN 


THIS SET. 


FMTOUT 


IS 


CALLED DIRECTLY BY CVSOUT. 




FNDFMT 


IS 


CALLED DIRECTLY BY FMTOUT, 


INTHOL, VECOUT. 


FRAME 


IS 


CALLED DIRECTLY BY DISPLA, 


GRAPH, GRAPHX. 


FRQCTl 


IS 


CALLED DIRECTLY BY POKCT1. 




FRQCT2 


IS 


NOT CALLED BY ANY PROGRAMS IN 


THIS SET. 


FSKIP 


IS 


CALLED DIRECTLY BY INDATA, 


LISTNG, SETINO, TRMINO. 


FT24 


IS 


NOT CALLED BY ANY PROGRAMS IN 


THIS SET. 


FXDATA 


IS 
IS 


CALLED DIRECTLY BY PAKN, 
CALLED INOIRECTLY BY QACORR, 


QACORR, QCNVLV, QXCORR, SPCOR2. 
QCNVLV, QXCORR, SPCOR2. 


GENHOL 


IS 


CALLED DIRECTLY BY COLABL. 




GETHOL 


IS 


NOT CALLED BY ANY PROGRAMS IN 


THIS SET. 


GETRD1 


IS 


CALLED DIRECTLY BY SHUFFL. 




GETX 


IS 


NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 


GNFLTl 


IS 


NOT CALLED BY ANY PROGRAMS IN 


THIS SET. 



• •»»»*»*•*•••••••»•••••• SUBROUTINE ♦•»«»*###*»*«#»««»»#*»*:# 

* GNHOL2 TO IPLYEV * CROSS-REFERENCE TABLE « 6NHOL2 TO IPLYEV • 
»•••*••*»••*»»**»»*»•«»* •*«•••»•«»••*»»»•••••*•• 



GNHOL2 IS CALLED OIRECTLY BY MOUTAI. 

GRAPH IS CALLED DIRECTLY BY GRAPHX. 

GRAPHX IS NOT CALLED BY ANY PROGRAMS IN THIS SET* 

GRUP2 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

HALVL t OF DUBLXt IS NOT CALLED BY ANY PROGRAMS IN THIS SET* 

HALVX , OF DUBLXt IS NOT CALLED BY ANY PROGRAMS IN THIS SET* 

HLADJ IS NOT CALLED DIRECTLY BY ANY PROGRAMS IN THIS SET* 
IS CALLED INDIRECTLY BY CSOUT, VOUT. 

HRADJ , OF HLADJ t IS CALLED BY CSOUT, VOUT. 

HSTPLT IS CALLED DIRECTLY BY GRAPH. 

HVTOIV IS CALLED DIRECTLY BY RDATA. 

IABS IS NOT CALLED BY ANY PROGRAMS IN THIS SET* 

ICOS , OF ISIN, IS NOT CALLED BY ANY PROGRAMS IN THIS SET* 

IDERIV IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

IEXP IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

IEXP<2 IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

IFNCTN IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

IGETX , OF GETX, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

IINTGR IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

ILOG IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

INDATA IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

INDEX IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 
INTGRA IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
I NTHOL IS CALLED DIRECTLY BY RDATA. 

INTMSBt OF TIMSUB, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
INTOPR IS CALLED DIRECTLY BY ARBCOL, EXPAND. 

INTSUM IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 
IOER , OF ( EXEM) 9 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
IPLYEV IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 



*•*•**•*****•*••»**••*»* 
* ISIN TO MAXABM » 
•*•»»•»»»»•••*»•*«*»**•* 
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«*»•*••••••*«••••••••••• 

* ISIN TO MAXABM * 
•••••*•*•»••••«*•••••••• 



ISIN IS NOT CALLED OIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 
ISQRT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
ITOMLI IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
IVTOHV IS CALLED OIRECTLY BY RDATA. 

IXCARG IS CALLED DIRECTLY BY COSIS1, FIRE2 , MIPLS, PLANSP t QXCOR1 , RDATA, 

RLSPR2. 

KIINTl IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

KOLAPS IS CALLED DIRECTLY BY PLANSP, XSPECT. 

LIMITS IS CALLED DIRECTLY BY PLANSP, QXCOR1. 

LINE IS CALLED DIRECTLY BY GRAPH. 

LINEH IS CALLED DIRECTLY BY HSTPLT. 

LINEV IS CALLED DIRECTLY BY HSTPLT. 

LINTR1 IS CALLED DIRECTLY BY NOINT1. 

LISTNG IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

LOC IS CALLED DIRECTLY BY INDATA, OUDATA. 

LOCATE IS CALLED DIRECTLY BY SEVRAL. 

IS CALLED INDIRECTLY BY RDATA, SEVRAL. 

LOG IS CALLED DIRECTLY BY CNTRDB, FACTOR, GRAPH, MOUTAI. 
IS NOT CALLED INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

LOGIO , OF LOG, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

LSHFT IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

LSLINE IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

LSSS1 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MATINV IS CALLED DIRECTLY BY MIPLS. 

MATML1 IS CALLED DIRECTLY BY MOOT. 

MATML3 IS CALLED DIRECTLY BY FIRE2, MDOT3, MIFLS, MIPLS, MISS, RLSPR2. 

MATRA IS CALLED DIRECTLY BY MIPLS, PLANSP, ROAR2. 

MATRA1 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
MAXAB , OF MAXSN, IS CALLED BY FACTOR, NRMVEC. 
MAXABM, OF MAXSNM, IS CALLED BY MOUTAI. 



* MAXSN TO MULLER » 
»•*«*•»**•*»•»*•***«•*»• 
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»»••**••••*••••*•••«#*•* 

» MAXSN TO MULLER « 
•*•***»«•***•**••#•«**«• 



MAXSN IS CALLED DIRECTLY BY PLTVSl. 

IS CALLED INDIRECTLY BY FACTOR, NRMVEC, PLTVSl* 

MAXSNM IS NOT CALLED DIRECTLY BY ANY PROGRAMS IN THIS SET. 
IS CALLED INDIRECTLY BY MOUTAI. 

MOOT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MDOT3 IS CALLED DIRECTLY BY CRSVM, MIPLS, MISS. 

MEMUSE IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MFACT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MIFLS IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MINAB , OF MAXSN, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MINABM, OF MAXSNM, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MINSN , OF MAXSN, IS CALLED BY PLTVSl. 

MINSNM, OF MAXSNM, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MIPLS IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MISS IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MLISCL IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MLI2A6 IS CALLED DIRECTLY BY PWMLIV. 

MONOCK IS CALLED DIRECTLY BY IFNCTN. 

MOUT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MOUTAI IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MOVE IS CALLED DIRECTLY BY MOUTAI, MOVECS, POLYDV, POLYSN, QFURRY, WLLSFP. 
MOVECS IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MOVREV IS CALLED DIRECTLY BY COSISi, MIFLS, MIPLS, MISS, PLANSP, RLSPR2, 

ROAR2. 

MPSEQ1 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MRVRS IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MSCON1 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MULK , OF ADDK, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MULKS , OF ADDK, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

MULLER IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 



**••**••»»••**•»•»*•»«»• 
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•»•««•*«»•»«•••»•«•«*••• 

» MULPLY TO PLTVSl * 
•**••»««•***•••••»••**•» 



MULPLY IS CALLED DIRECTLY BY MOUTAI, PLTVSl • 

IS NOT CALLED INDIRECTLY BY ANY PROGRAMS IN THIS SET* 

MUVADD IS NOT CALLED BY ANY PROGRAMS IN THIS SET* 

MVBLOK IS CALLED DIRECTLY BY GRAPH, INOATA, OUDATA. 

MVINAV IS NOT CALLED BY ANY PROGRAMS IN THIS SET* 

MVNSUM IS NOT CALLED BY ANY PROGRAMS IN THIS SET* 

MVNTIN IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 
MVNTNA t OF MVNTIN, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
MVSQAV IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
MXRARE IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
NEXCOS, OF SEQSAC, IS CALLED BY ASPEC2* 

NEXSIN, OF SEQSAC, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

NMZMG1 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

NOINT1 IS CALLED DIRECTLY BY KIINT1. 

IS NOT CALLED INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

NOINT2, OF NOINT1, IS NOT CALLED BY ANY PROGRAMS IN THIS SET* 

NRMVEC IS NOT CALLED BY ANY PROGRAMS IN THIS SET* 

NTHA IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

NURINC IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

NXALRM IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

ONLINE IS NOT CALLED DIRECTLY BY ANY PROGRAMS IN THIS SET. 

IS CALLED INDIRECTLY BY CARIGE, CNTRDB, COLABL, CONTUR, CSCUT, DADECK, 

FMTOUT, INDATA, LISTNG, MEMUSE, MOUT, MOUTAI, 
PLOTVS, PLTVSl, PWMLIV, RDATA, VECOUT, VOUT. 

OUDATA IS CALLED OIRECTLY BY TRMINO. 

PACDAT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

PAKN IS CALLED DIRECTLY BY OUDATA. 

PDUMP , OF DUMP, IS CALLED BY C EXEM \ • 

PLANSP IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

PLOTVS IS CALLED DIRECTLY BY PLTVSl. 

PLTVSl IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 



•*•••»»**»•*•*»»•»*«»»•« 

* PLURAL TO REREAD * 
*•»•••«•»••««•»**•*••»•* 
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« PLURAL TO REREAO • 
*•••»»»••••••*»*••»«•••* 



PLURAL , OF SEVRALt IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

PLURNS IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

PLYSYN IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

POKCT1 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

POLYDV IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

POLYEV IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

POLYSN IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

POWER IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

PRBFIT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

PROB2 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

PROCOR IS CALLED DIRECTLY BY QACORR, QCNVLV, QXCORRt QXCORi. 

IS CALLED INDIRECTLY BY QACORR, QCNVLV, QXCORR, QXCORI. 

PSQRT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

PWMLIV IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

QACORR IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

QCNVLV IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

QFURRY IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

QIFURY IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

QINTR1 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

QUFIT1 IS CALLED DIRECTLY BY CNTROW, QINTR1. 

QXCORR IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

QXCORI IS CALLED DIRECTLY BY SPCOR2. 

RDATA IS NOT CALLEO BY ANY PROGRAMS IN THIS SET. 

REFIT , OF SPLIT, IS CALLED BY XSPECT. 

REFLEC IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

REIM , OF AMPHZ, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

REMAV IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

REREAD IS NOT CALLED DIRECTLY BY ANY PROGRAMS IN THIS SET. 
IS CALLED INDIRECTLY BY DADECK, GETRD1, RDATA. 



•**••****»•*•••»**»*••*• 
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••«•••»•»»»»•••**•»«»«•• 

* RETURN TO SETINO » 
••*•»••••»•••*»•••*•«••• 



RETURN, OF LOCATE, IS CALLED BY RDATA. 

REVER IS CALLED DIRECTLY BY FNDFMT, IFNCTN. 

REVERS IS CALLED DIRECTLY BY CROST, GETHOL, MRVRS, QXCOR1, RGAR2. 

RLSPR IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

RLSPR2 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

RLSSR IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

RMSDAV, OF RMSDEV, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

RMSDEV IS CALLED DIRECTLY BY PLTVS1. 

IS NOT CALLED INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

RND IS CALLED DIRECTLY BY AMPHZ, CNTROW, MOUTAI, PLOTVS, RNDV. 

IS CALLED INDIRECTLY BY CNTROW, CONTUR, QINTR1 , RNDV. 

RNDDN , OF RND, IS CALLED BY CNTROW, CONTUR, RNDV. 

RNDUP , OF RND, IS CALLED BY CNTROW, CONTUR, QINTR1, RNDV. 

RNDV IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

RNDVDN, OF RNDV, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

RNDVUP, OF RNDV, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

ROAR2 IS CALLED DIRECTLY BY PLANSP. 

ROTATi IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

RPLFMT IS CALLED DIRECTLY BY FMTOUT, VECOUT. 

RSKIP IS CALLED DIRECTLY BY DADECK. 

RVPRTS, OF CHPRTS, IS CALLED BY ASPECT. 

SAME IS CALLED DIRECTLY BY CNTRDB, LISTNG, MOUTAI. 

IS CALLED INDIRECTLY BY CONTUR, INDATA, LISTNG, PLTVS1. 

SCPSCL IS CALLED DIRECTLY BY GRAPH. 

SEARCH IS CALLED DIRECTLY BY SHUFFL. 

SEQSAC IS CALLED DIRECTLY BY ASPEC2. 

IS CALLED INDIRECTLY BY ASPEC2. 

SETAPT , OF INDEX, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SETEST, OF INDEX, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SETINO IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 



* SETK TO SPCGR2 » 
*••*••»•«••*•••»*•••••*• 
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•••••*«••••**•»«•»•••«•« 

« SETK TO SPCOR2 * 
•••*»•••«***«•*••••*•••• 



SETK IS CALLED OIRECTLY BY SETKP. 

IS CALLEO INDIRECTLY BY CNTRDB, CRSVM, PLANSP, PLCTVS, PLTVS1, QXCOR1, 

SETKP. 

SETKP IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

SETKS , OF SETK, IS CALLED BY CRSVM, PLANSP, PLOTVSt PLTVSlt QXCORI. 

SETKV IS CALLED DIRECTLY BY PLOTVS. 

SETKVS IS CALLED DIRECTLY BY PLTVS1. 

SETLIN IS CALLED DIRECTLY BY SETLNS. 

IS CALLED INDIRECTLY BY PLTVS1, SETLNS, 

SETLNS IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SETSBV, OF LOCATE, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SETUP , OF LOCATE, IS CALLED BY RDATA. 

SETVCP, OF SETKP, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SETVEC, OF SETK, IS CALLED BY CNTRDB, PLOTVS, PLTVS1, SETKP. 

SEVRAL IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

SHFTR1 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SHFTR2 IS CALLED DIRECTLY BY LISTNG. 

SHUFFL IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SIFT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SIMEQ IS CALLED DIRECTLY BY MAT INV, RLSPR2. 

IS NOT CALLED INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

SIN , OF COS, IS CALLED BY ADANL, AMPHZ, COSTBL, SEQSAC. 

SINTBL, OF COSTBL, IS CALLED BY PLANSP, QFURRY , OIFURY. 

SINTBX, OF COSTBL, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SISP , OF COSP, IS CALLED BY COSIS1. 

SIZEUP IS CALLED DIRECTLY BY SHUFFL. 

IS NOT CALLED INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

SIZUPL, OF SIZEUP, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SMPRDV, OF POWER, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SMPSON IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SPCOR2 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 



•«•*****»••*•*•**»••••»» 

• SPLIT TO TINGL * 
•*••*•»*•«*»*•**•»»•*•*» 



SUBROUTINE 
CROSS-REFERENCE TABLE 



••••»»»»••»•••*•••••»••« 

* SPLIT TO TINGL * 
•«•••*••»*••••»**•«••*•* 



SPLIT IS CALLED DIRECTLY BY ASPECT, COSIS1, XSPECT. 
IS CALLED INDIRECTLY BY XSPECT. 

SQRDEV, OF SQRDFR, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SQRDFR IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

SQRMLI IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SQROOT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SQRSUM IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

SQRT IS CALLED DIRECTLY BY AMPHZ, IABS, KIINTi, MFACT, MULLER» NRMVEC, 

POLYSN, PRBFITf PSQRT, RMSDEV, SQROOT, XSQRUT. 

SQUARE IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

SRCH1 IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

STEPC , OF DELTA, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

STEPL , OF DELTA, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

STEPR , OF DELTA, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

STORE , OF LOCATE, IS CALLED BY RDATA. 

STZ IS CALLED DIRECTLY BY CROSS, CRSVM, FIRE2, MFACT, MIPLS, PLANSP, 

POLYDV, QFURRY, QXCOR1, RLSPR2, SPC0R2. 

STZS IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SUBK , OF ADDK, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SUBKS , OF ADDK, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SUM IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

SUMDEV, OF SUMDFR, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

SUMDFR IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

SWITCH IS CALLED DIRECTLY BY CONTUR, PLOTVS. 

TAMVL IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 
TAMVR , OF TAMVL, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
TANH IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
TIMA2B IS CALLED DIRECTLY BY TIMSUB. 

TIMSUB IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 
TINGL IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 



* TINGLA TO XDANL * 
*»*«»*••••»•»**«•*»»*•«• 



SUBROUTINE 
CROSS-REFERENCE TABLE 



*••»••»*••*«•**«•••»•••• 

* TINGLA TO XOANL * 
•*•«»•»•»•«««»»•••••»*•* 



TINGLA, OF TINGL, IS NOT CALLEO BY ANY PROGRAMS IN THIS SET* 
TRMINO IS NOT CALLED BY ANY PROGRAMS IN THIS SET, 
UNPAKN IS CALLED DIRECTLY BY INDATA. 

VARARG IS CALLED DIRECTLY BY INDATA, OUDATA, PLTVSl. 
VDOTV IS NOT CALLEO BY ANY PROGRAMS IN THIS SET. 
VDVBYV IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
VECOUT IS CALLED DIRECTLY BY CVSOUT, VOUT, VRSOUT. 
VINDEX, OF INDEX, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
VMNUSV, OF VPLUSV, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
VOUT IS CALLED DIRECTLY BY VSOUT. 

VPLUSV IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 
VRSOUT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
VSOUT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

VTIMSV IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 
WAC IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 
WHERE , OF LOCATE, IS CALLED BY SEVRAL. 

WHICH IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

WLLSFP IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

WRTDAT IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XACTEQ IS CALLED DIRECTLY BY SRCH1. 

XADDK , OF ADDK, IS CALLEO BY PLANSP. 

XADDKS , OF ADDK, IS CALLED BY PLANSP. 

XARG , OF LOCATE, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XAVRGE IS NOT CALLED DIRECTLY BY ANY PROGRAMS IN THIS SET. 
IS CALLED INDIRECTLY BY XREMAV. 

XAVRGR, OF XAVRGE, IS CALLED BY XREMAV. 

XBOOST, OF BOOST, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XCMPRA, OF CMPRA, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XDANL , OF ADANL, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 



***•*•*•*»*»*••*•»***••» 

» XOANX TO XOOZE * 



SUBROUTINE 
CROSS-REFERENCE TABLE 



*•«»*•»•*••••••*»*«*•••» 

« XOANX TO XOOZE » 
•»••«••«•»•*•••••••«•«*• 



XOANX , OF AOANLt IS NOT CALLED BY ANY PROGRAMS IN THIS SET* 

XDELTA, OF DELTA, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XDFPRS, OF DIFPRS, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XDIV IS CALLED DIRECTLY BY XAVRGEt XDVIDE , XVDVBV. 

IS CALLED INDIRECTLY BY XAVRGEt XDVIDE , XVDVBV. 

XDIVK , OF ADDK, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XDIVKS, OF ADDKt IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XDIVR , OF XDIV, IS CALLED BY XAVRGEt XDVIDE, XVDVBV. 

XDPRSS, OF BOOST, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XDVIDE IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 

XDVIDR, OF XDVIDE, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XDVRK , OF A DDK, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XDVRKS, OF ADDK, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XFIXM IS CALLED DIRECTLY BY GRAPH. 

XINDEX, OF LOCATE, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XLCOMN IS CALLED DIRECTLY BY MEMUSE. 

XLIMIT IS CALLED DIRECTLY BY SETINO, TRMINO. 

XLOC IS CALLED DIRECTLY BY GETHOL, GRAPH, IXCARG, PLTVS1, QCNVLV, QIFURY, 













QXCORR, 


SPCOR2, XSPECT. 




XLOCV 


IS ! 


NOT CALLED BY ANY PROGRAMS 


i IN 


THIS SET. 








XLSHFT, 


OF 


LSHFT, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XMLPLY, 


OF 


MULPLY, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XMULK , 


OF 


ADDK, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XMULKS, 


OF 


ADDK, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XNAME , 


OF 


LOCATE, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XNARGS, 


OF 


LOCATE, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XNTHA , 


OF 


NTHA, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XNTSUM, 


OF 


INTSUM, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 



XOOZE IS CALLED DIRECTLY BY PLANSP. 



•*«**»•**»*»*»»••*••*»*» 

* XREMAV TO ZEF8IN » 
**•*•*«**•»»»*«»••»•»**• 



SUBROUTINE 
CROSS-REFERENCE TABLE 



*»»«##»»*»♦•»»#•*#»«»»## 

• XREMAV TO ZEFBIN * 

»###»»»«### •••» •••• «»#»'* 



XREMAV IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 

XRFLECt OF REFLEC, IS NOT CALLEO BY ANY PROGRAMS IN THIS SET. 

XSAME , OF SAME, IS CALLEO BY CONTUR, INDATA, LISTNG, PLTVS1. 



XSMDEV, 


OF 


SUMOFR, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XSMOFR, 


OF 


SUMOFR, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XSPECT 


IS 


CALLED DIRECTLY 


BY QFURRY. 










XSQDEV, 


OF 


XSQDFR, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XSQDFR 


IS 


NOT CALLED 1 


DIRECTLY OR 


INDIRECTLY BY ANY PROGRAMS I 


XSQRUT 


IS 


NOT CALLED 1 


BY ANY PROGRAMS IN 


THIS SET. 








XSQSUM, 


OF 


SQRSUM, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XSQUAR, 


OF 


SQUARE, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XSTEPC, 


OF 


DELTA, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XSTEPL, 


OF 


DELTA, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XSTEPR, 


OF 


DELTA, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XSTLIN, 


OF 


SETLIN, 


IS 


CALLED BY PLTVS1, 


SETLNS. 








XSUBK , 


OF 


ADDK, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XSUBKS, 


OF 


ADDK, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XSUM , 


OF 


SUM, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XVDRBV, 


OF 


XVDVBV, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XVOV8V 


IS i 


NOT CALLED 1 


DIRECTLY OR 


INDIRECTLY BY ANY PROGRAMS II 


XVMNSV, 


OF 


VPLUSV, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XVPLSV, 


OF 


VPLUSV, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XVTMSV, 


OF 


VTIMSV, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 


XWHICH, 


OF 


WHICH, 


IS 


NOT 


CALLED 


BY 


ANY 


PROGRAMS 


IN 


THIS 


SET. 



ZEFBCD IS NOT CALLED DIRECTLY OR INDIRECTLY BY ANY PROGRAMS IN THIS SET. 
ZEFBIN, OF ZEFBCD, IS NOT CALLED BY ANY PROGRAMS IN THIS SET. 



9 

Subroutine Rosters 
For the 

One-Pass Library 



The cross-reference table of the preceding section is principally of value in work on the 
library itself, since (in conjunction with the tables of Section 7) one can use it to deter- 
mine the effects of repositioning or deleting individual programs. Of greater utility to 
the working programmer are data on the lower-level environment of a given program. 
The ' ' subroutine rosters" of the present section provide this type of data for the sub- 
routine library defined in Section 7. 

We define the subroutine roster of a given program as a list of all programs 
needed to make the given program operative. For a programmer who does not use a 
library tape but has access to a drawer of binary decks, the roster is a list of all the 
additional binary decks he must collect to make possible the execution of a given pro- 
gram. In any event, it is desirable that (1) such lists be expressed in terms of 
principal entry names, and that (2) each such list be subdivided into FORTRAN System 
routines and non-FORTRAN-System routines. [Note that because of (1) the names in 
the roster may not coincide with the names in the transfer vectors of the program and 
in its lower-level programs] 

The roster tables that follow are designed to fill these two prescriptions. In 
addition, they give memory-storage requirements (in decimal) of the given program, 
of each principal entry in its roster, and of the whole set. The tables are organized 
alphabetically by all entry names in the library (for secondary entries no rosters are 
given, only references to their principal entries). The phrase 

NEEDS FSRS - 

is used to introduce a subroster of FORTRAN System routines, and the phrase 
NEEDS SRS - 

is used to head a subroster of subroutines (or functions) not in the FORTRAN System. 
The absence of a transfer vector is denoted by the expression 

NEEDS NO LOWER ROUTINES 



186 



»•»»•*•**•«•*•»*••••••»• 

• ( BSR) TO UOB) • 
••••*»•*»»»•»»•«*»»*»*•* 



SUBROUTINE ROSTERS 



•••*••*•••••••»*•#•#»*•* 

« (BSRI TO (ICB1 ♦ 
••»*•«*«••••*»**••••*••« 



( BSR) (SECONDARY ENTRY OF (IOS) ) 

C BST ) PROGRAM PROPER.... 28 

NEEDS FSRS - (EXEM) 458, (IOS) 87, (IOU) 24, CTES) 1, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 792 

(BUF) (SECONDARY ENTRY OF (IOB) ) 

(CSH) PROGRAM PROPER.. .. 125 

NEEDS FSRS - (EXEM) 458, UOH) 1016, ( IOS) 87, (IOU) 24, 

(TES) I, DUMP 177, EXIT 17 1780 

STORAGE TOTAL.... 1905 

(DFAD) NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 80 

(DFDP) (SECONDARY ENTRY OF (DFAD)) 
(DFMP) (SECONDARY ENTRY OF (DFAD)) 
(DFSB) (SECONDARY ENTRY OF (DFAD)) 

(EFT) PROGRAM PROPER.... 7 

NEEDS FSRS - (EXEM) 458, (IOS) 87, ( IOU) 24, (TES) 1, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 771 

(ETT) (SECONDARY ENTRY OF (IOS) ) 
(EXB) (SECONDARY ENTRY OF (IOB) ) 
(EXE) (SECONDARY ENTRY OF (EXEM)) 

(EXEM) PROGRAM PROPER.... 458 

NEEDS FSRS - (IOS) 87, (IOU) 24, (TES) 1, DUMP 177, 

EXIT 17 306 

STORAGE TOTAL.... 764 

(FIL) (SECONDARY ENTRY OF ( IOH) ) 

(FPT) PROGRAM PROPER.... 41 

NEEDS FSRS - (EXEM) 458, (IOH) 1016, ( IOSI 87, (IOU) 24, 

(TES) 1, DUMP 177, EXIT 17 1780 

STORAGE TOTAL.... 1821 

(IFDP) (SECONDARY ENTRY OF (IFMP)i 

(IFMP) NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 136 

(IOB) PROGRAM PROPER.... 570 
NEEDS FSRS - (EXEM) 458, (IOS) 87, (IOU) 24, (TES) 1, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 1334 



••»•»*»•»»•»••**»*****•* SUBROUTINE ROSTERS #»*»»»»»»*»»»»*»•»#»#«»« 



(IOHI PROGRAM PROPER.... 1016 

NEEOS FSRS - (EXEM) 458, (IOS) 87, (IOU) 24, (TES) 1, 

DUMP 177, EXIT 17 ............. 764 

STORAGE TOTAL.... 1780 

(IOS) PROGRAM PROPER.... 87 

NEEDS FSRS - (EXEM) 458, (IOU) 24, (TES) 1, DUMP 177, 

EXIT 17 677 

STORAGE TOTAL.... 764 

(IOU) NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 24 

(RCH) (SECONDARY ENTRY OF (IOS) ) 
(RDC) (SECONDARY ENTRY OF ( RER) ) 
(RDS) (SECONDARY ENTRY OF (IOS) ) 

( RER) PROGRAM PROPER.... 37 

NEEDS FSRS - (EXEM) 458, (IOS) 87, ( IOUI 24, (TES) 1, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 801 

(REW) (SECONDARY ENTRY OF (IOS) ) 
(RLR) (SECONDARY ENTRY CF (TSB) ) 
(RTN) (SECONDARY ENTRY OF ( IOH) I 

(RWT) PROGRAM PROPER.... 7 

NEEDS FSRS - (EXEM) 458, (IOS) 87, (IOU) 24, (TES) 1, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 771 

(SCH) PROGRAM PROPER.... 96 

NEEDS FSRS - (EXEM) 458, (IOH) 1016, ( IOSI 87, (IOU) 24, 

(TES ) I, DUMP 177, EXIT 17 1780 

STORAGE TOTAL.... 1876 

(SET) (SECONDARY ENTRY OF ( IOB) ) 

(SLI) NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 13 

(SLO) NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 13 

(SPH) PROGRAM PROPER.... 183 
NEEDS FSRS - (EXEM) 458, (IOH) 1016, (IOS) 87, (IOU) 24, 

(TES) I, DUMP 177, EXIT 17 1780 

STORAGE TOTAL.... 1963 

{ STB) PROGRAM PROPER.... 53 
NEEDS FSRS - (EXEM) 458, (IOB) 570, (IOS) 87, (IOU) 24, 

(TES) I, (WER) 57, DUMP 177, EXIT 17 .... 1391 

STORAGE TOTAL.... 1444 



*•»»•**»*•»»**••*«•*••«• 

* (STH) TO AMPHZ ♦ 
***•***••«*»•***•*»•«••• 



SUBROUTINE ROSTERS 



* (STHI TO AMPHZ * 
•••«**•«•••«»«•#*••«»*•* 



(STHI 

NEEDS 


FSRS - (EXEM) 
(TES) 


458, (IOH) 
1, (WER) 


1016, 
57, 


( IOS) 
DUMP 


PROGRAM PROPER. 
87, (IOU) 24, 
177, EXIT 17 . 
STORAGE TOTAL. 


... 

... 
... 


CSTHDI 


(SECONDARY ENTRY 


OF (STH) ) 










(STHM) 


(SECONDARY ENTRY 


CF ( STH) ) 










(TCOI 


(SECONDARY ENTRY 


OF CIOS! ) 










( TEF) 


(SECONDARY ENTRY 


OF (IOS) ) 










(TES) 


NEEDS NO LOWER ROUTINES 






STORAGE TOTAL. 


... 


( TRC ) 


(SECONDARY ENTRY 


OF (IOS) 1 










( TSB) 

NEEDS 


FSRS - (EXEM) 
(RER) 


458, (IQB) 
37, (TES) 


570, 
It 


{ IOS) 
DUMP 


PROGRAM PROPER. 
87, (IOU) 24, 
177, EXIT 17 . 

CTnn*rc TOT It 1 

STORAGE TOTAL. 


... 

. * . 
... 


(TSH) 


(SECONDARY ENTRY 


CF REREAD! 










( TSHMI 


(SECONDARY ENTRY 


OF REREAD ) 










( WEF) 


(SECONDARY ENTRY 


CF (IOS) ) 










(WER) 
NEEDS 


FSRS - (EXEM) 
DUMP 


458, (IOS) 
177, EXIT 


87, 


( IOU) 


PROGRAM PROPER. 
24, (TES) I, 


. . . 








STORAGE TOTAL. 


. . . 


(WLR) 


(SECONDARY ENTRY 


OF (STB) ) 










(WRS) 


(SECONDARY ENTRY 


OF (IOS) ) 










(WTC) 


(SECONDARY ENTRY 


OF (WER) ) 










ABSVAL 


NEEDS NO LOWER ROUTINES 






STORAGE TOTAL. 


. . . 


ADANL 
NEEDS 


FSRS - COS 








PROGRAM PROPER. 


. . . 








STORAGE TOTAL. 




ADANX 


(SECONDARY ENTRY 


OF ADANL ) 










ADDK 


NEEDS NO LOWER ROUTINES 






STORAGE TOTAL. 


. . . 


ADDKS 


(SECONDARY ENTRY 


OF ADDK ) 










AMPHZ 

NEEDS SRS - RND 
AND FSRS - ATAN 








PROGRAM PROPER. 


. . • 


77, COS 


105, 


SQRT 







83 

1837 
1920 



66 

1371 
1437 



57 

764 
821 



STORAGE TOTAL., 



50 

183 
105 
288 



114 



149 
15 
226 
390 



» ARBCOL TO CHUSET » 
***•*•*»••»••*•****»••*• 



SUBROUTINE ROSTERS 



»•••»•••»»••••»•*»••**•* 

» ARBCOL TO CHUSET » 



ARBCOL PROGRAM PROPER* • . • 129 

NEEDS SRS - INTOPR ill ....... • Ill 

STORAGE TOTAL.... 240 

ARCTAN PROGRAM PROPER.*.. 29 

NEEOS FSRS - ATAN 77 77 

STORAGE TOTAL.... 106 

ARG (SECONDARY ENTRY OF LOCATE ) 

ASPECT PROGRAM PROPER.... 278 
NEEDS SRS - CHPRTS 76, COLAPS 50, COSP 504, DUBLX 45, 

SPLIT 224 899 

STORAGE TOTAL.... 1177 

ASPEC2 PROGRAM PROPER.... 74 

NEEDS SRS - SEQSAC 94 94 

AND FSRS - COS 105 105 

STORAGE TOTAL.... 273 

ATAN NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 77 

AVRAGE NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 24 

BLKSUM NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 49 

BOOST NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 34 
CALL (SECONDARY ENTRY OF LOCATE I 
CALL2 (SECONDARY ENTRY OF LOCATE) 

CARIGE PROGRAM PROPER.... 47 

NEEDS SRS - ONLINE 134 • 134 

AND FSRS - (EXEM) 458, (IOH) 1016, (IOSJ 87, (IOU) 24, 
(SPHI 183, (TESt 1, CWERI 57, DUMP 177, 

EXIT 17 • • • 2020 

STORAGE TOTAL.... 2201 

CHAIN PROGRAM PROPER.... 179 

NEEDS FSRS - (TESI 1, EXIT 17 18 

STORAGE TOTAL.... 197 

CHISQR NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 105 

CHOOSE NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 17 

CHPRTS NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 76 

CHSIGN NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 18 
CHUSET (SECONDARY ENTRY CF INDEX I 



*»•»»«»»»*••*»«»»»•««»*» SUBROUTINE ROSTERS •#*»#»#«»»##»»»»#»^«#*»# 

* CLKON TO COS » * CLKON TO CCS » 

»*•»*•*»»**»«••**••»»*»» ••»••*••*•••»•»••••»•••« 

CLKON PROGRAM PROPER.... 46 

NEEDS SRS - CLOCK1 57 57 

AND FSRS - (EXEM) 458, < IOHI 1016, { IOSI 87, (IOU) 24, 

(SPHI 183, (TES) 1, DUMP 177, EXIT 17 .... 1963 

STORAGE TOTAL.... 2066 

CL0CK1 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 57 

CMPARL (SECONOARY ENTRY OF CMPARV) 

CMPARP NEEOS NO LOWER ROUTINES STORAGE TOTAL.... 53 

CMPARS (SECONDARY ENTRY OF CMPARP ) 

CMPARV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 50 

CMPRA NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 18 

CMPRFL (SECONDARY ENTRY OF CMPRA I 

CNTRD8 PROGRAM PROPER.... 550 

NEEDS SRS - ARBCOL 129, CNTROW 802, COLABL 185, CONTUR 587, 
CUFIT1 158, FASCUE* 141, GENHOL 48, INTOPR 111, 
ONLINE 134, QUFIT1 79, RND 15, SAME 1, 

SETK 37, SWITCH 15 2442 

AND FSRS - (EXEM) 458, ( IOH) 1016, (IOS) 87, (IOUI 24, 
(SPHI 183, (TESI 1, (WERI 57, DUMP 177, 

EXIT 17, EXP 52, LOG 53 2125 

STORAGE TOTAL.... 5117 

CNTROW PROGRAM PROPER.... 802 

NEEDS SRS - CUFIT1 158, FASCUB 141, QUFIT1 79, RND 15 .... 393 

STORAGE TOTAL.... 1195 

COLABL PROGRAM PROPER.... 185 

NEEDS SRS - GENHOL 48, ONLINE 134 182 

ANO FSRS - (EXEM) 458, (IOH) 1016, (IOS) 87, (IOU) 24, 
(SPH) 183, (TES) 1, (WER) 57, DUMP 177, 

EXIT 17 • 2020 

STORAGE TOTAL.... 2387 

COLAPS NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 50 

CONTUR PROGRAM PROPER.... 587 

NEEDS SRS - ARBCOL 129, CNTROW 802, COLABL 185, CUFIT1 158, 
FASCUB 141, GENHOL 48, INTOPR 111, ONLINE 134, 
QUFIT1 79, RND 15, SAME 1, SWITCH 15 .... 1818 
ANO FSRS - (EXEM) 458, (IOH) 1016, (IOS) 87, (IOU) 24, 
(SPH) 183, (TES) 1, (WER) 57, DUMP 177, 

EXIT 17 2020 

STORAGE TOTAL.... 4425 

CONVLV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 56 



COS NEEDS NO LOWER ROUTINES 



STORAGE TOTAL.. 



105 



••*••••****•*••»••»••*•» 

* COSISP TO CVSOUT » 
*»**»*»«•»*»»••»•»*»»••• 



SUBROUTINE ROSTERS 



••*****»•*«»*•••***«••** 

* COSISP TO CVSGUT * 
••»•*•***«**•»*«•••*•*•* 



COSISP (SECONDARY ENTRY CF COSP I 

COSIS1 PROGRAM PROPER* • • • 406 
HEEDS SRS - CHPRTS 76, COSP 504, IXCARG 35, MGVREV 74, 

SPLIT 224 • . 913 

A NO FSRS - XLOC 12 12 

STORAGE TOTAL.... 1331 

COSP NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 504 

COSTBL PROGRAM PROPER.... 121 

NEEDS FSRS - COS 105 105 

STORAGE TOTAL.... 226 

COSTBX (SECONDARY ENTRY OF COSTBL I 

CPYFL2 PROGRAM PROPER.... 178 
NEEDS FSRS - (EXEMI 458, (IOS) 87, i IOUI 24, (TESf 1, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 942 

CROSS PROGRAM PROPER.... 107 

NEEDS SRS - FDOT 40, STZ 14 54 

STORAGE TOTAL.... 161 

CROST PROGRAM PROPER.... 134 

NEEDS SRS - CROSS 107, FDOT 40, REVERS 29, STZ 14 .... 190 

STORAGE TOTAL.... 324 

CRSVM PROGRAM PROPER.... 327 
NEEDS SRS - DOTJ 59, MATML3 120, MD0T3 122, SETK 37, 

STZ 14 352 

STORAGE TOTAL.... 679 

CSOUT PROGRAM PROPER.... 49 

NEEDS SRS - CARIGE 47, HLADJ 46, ONLINE 134 227 

AND FSRS - (EXEM) 458, (IOH) 1016, (IOS) 87, (IOU) 24, 
(SPH) 183, (TESI 1, (WERI 57, DUMP 177, 

EXIT 17 • • 2020 

STORAGE TOTAL.... 2296 

CUFIT1 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 158 

CVSOUT PROGRAM PROPER.... 84 
NEEDS SRS - CARIGE 47, FMTOUT 51, FNDFMT 88, ONLINE 134, 

REVER 30, RPLFMT 17, VECOUT 66 433 

AND FSRS - (EXEMI 458, (IOH) 1016, (IDS) 87, (IOUI 24, 
(SPH) 183, (TES) It (WER) 57, DUMP 177, 

EXIT 17 • 2020 

STORAGE TOTAL.... 2537 



•»«»»»•«•••••••»***•»••• 

» DOTJ TO FAPSUM • 
••*•••**»»»»••»*••»*»»•» 



SUBROUTINE ROSTERS 



••••••»•••••*•••*«#*•••• 

* DOTJ TO FAPSUM # 



DOTJ NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 59 

DOTP PROGRAM PROPER.... 264 

NEEDS SRS - DOTJ 59 59 

STORAGE TOTAL.... 323 

DPRESS (SECONDARY ENTRY OF BOOST I 

DSIN NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 222 

DSPFMT NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 194 

DSQRT PROGRAM PROPER.... 66 
NEEDS FSRS - (EXEM) 458, (IOS) 87, C IOUI 24, (TES) 1, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 830 

DUBLL (SECONDARY ENTRY OF DUBLX I 

DUBLX NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 45 

DUMP PROGRAM PROPER.... 177 

NEEDS FSRS - (TESI 1, EXIT 17 18 

STORAGE TOTAL.... 195 

ENDFIL (SECONDARY ENTRY OF REREAD) 
EOFSET (SECONDARY ENTRY OF REREAD) 

EXCHVS NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 22 
EXEDMP (SECONDARY ENTRY OF (EXEM)) 

EXIT PROGRAM PROPER.... 17 

NEEDS FSRS - (TES) 1 1 

STORAGE TOTAL.... 18 

EXP NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 52 

EXPU NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 35 

EXP(2 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 38 

EXP (3 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 93 

EXPAND PROGRAM PROPER. ... 189 

NEEDS SRS - INTOPR 111 Ill 

STORAGE TOTAL.... 300 

FACTOR PROGRAM PROPER.... 308 

NEEDS SRS - COSP 504, COSTBL 121, MAXSN 54 679 

AND FSRS - COS 105, EXP 52, LOG 53 210 

STORAGE TOTAL.... 1197 

FAPSUM NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 14 



•******««•*«*••••••••»•• 

* OADECK TO DMOD » 
••»*•*•••••*•**••*»••••• 



SUBROUTINE ROSTERS 



•**••»***•*•••*•*»#•**•* 

* DADECK TO DMOO * 
»•*•»*•**•*•»»»•*»**#«•« 



OADECK PROGRAM PROPER.... 100 

NEEDS SRS - ONLINE 134, REREAD 114, RSKIP 37 285 

AND FSRS - (EXEMI 458, (IOHI 1016, ( IOSI 87, (IOUI 24, 
(RER ) 37, CSPHI 183, (TESI 1, (WER) 57, 

DUMP 177, EXIT 17 2057 

STORAGE TOTAL.... 2442 

DAT AN NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 440 

DATAN2 (SECONDARY ENTRY OF DATAN ) 
DCOS (SECONDARY ENTRY OF DSIN ) 

DELTA NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 17 

DERI VA NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 61 

DETRM (SECONDARY ENTRY CF SIMEQ I 

DEXP PROGRAM PROPER.... 153 

NEEDS FSRS - (EXEM) 458, (IOS) 87, ( IOU) 24, (TESI I, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 917 

DEXP(2 (SECONDARY ENTRY OF IEXP(2) 

DEXP(3 PROGRAM PROPER.... 34 

NEEDS FSRS - (EXEMI 458, (IOS) 87, (IOU) 24, (TESI 1, 

DEXP 153, DLOG 273, DUMP 177, EXIT 17 .... 1190 

STORAGE TOTAL.... 1224 

DIFPRS NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 30 

DINT NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 10 

DISPLA PROGRAM PROPER.... 219 

NEEDS SRS - FRAME 9 9 

AND FSRS - (EXEMI 458, (IOH) 1016, (IOSI 87, (IOUI 24, 

(TESI 1, DUMP 177, EXIT 17 1780 

STORAGE TOTAL.... 2008 

DIVIDE NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 23 

DIVK (SECONDARY ENTRY OF A DDK I 
DIVKS (SECONDARY ENTRY CF AODK I 

DLOG PROGRAM PROPER.... 273 

NEEDS FSRS - ( EXEM I 458, (IOSI 87, (IOU) 24, (TESI I, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 1037 

DLOG10 (SECONDARY ENTRY OF DLOG ) 



DMOD 



NEEDS NO LOWER ROUTINES 



STORAGE TOTAL.. 



48 



»*•**»*•«*•**••••*«•*»»• SUBROUTINE ROSTERS 

* FASCN1 TO FSKIP » 



••***•»•*»••*•*•••»•••*• 

» FASCN1 TO FSKIP • 
•*»*»•»••**•»•»•«••••••• 



FASCN1 NEEOS NO LOWER ROUTINES STORAGE TOTAL. • • • 107 
FASCOR (SECONDARY ENTRY OF PROCORI 
FASCR1 (SECONDARY ENTRY OF PROCORI 

FASCUB NEEDS NO LOWER ROUTINES STORAGE TOTAL*... 141 
FASEPC (SECONDARY ENTRY OF PROCORI 
FASEPl (SECONDARY ENTRY OF PROCORI 

FASTRK NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 26 

FOOT NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 40 
FDOTR (SECONDARY ENTRY OF FOOT I 

FIRE2 PROGRAM PROPER.... 271 
NEEDS SRS - DOTJ 59, DOTP 264, IXCARG 35, MATML3 120, 

STZ 14 492 

AND FSRS - XLOC 12 • 12 

STORAGE TOTAL.... 775 

FIXV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 35 
FIXVR (SECONDARY ENTRY OF FIXV I 
FLOATA (SECONDARY ENTRY OF FXDATAI 

FLOATM NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 25 

FLOATV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 22 

FMTOUT PROGRAM PROPER.... 51 

NEEDS SRS - FNDFMT 88, ONLINE 134, REVER 30, RPLFMT 17 .... 269 
AND FSRS - (EXEM) 458, (IOHl 1016, (IOSI 87, UOU) 24, 
(SPH) 183, (TES) It (WERI 57, DUMP 177, 

EXIT 17 • . •• ••••• 2020 

STORAGE TOTAL.... 2340 

FNDFMT PROGRAM PROPER.... 88 

NEEDS SRS - REVER 30 30 

STORAGE TOTAL.... 118 

FRAME NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 9 

FRQCTl NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 117 

FRQCT2 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 117 

FSKIP PROGRAM PROPER.... 50 
NEEDS FSRS - ( EXEMI 458, (IDS) 87, (I0U) 24, (TES) 1, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 814 



«*»•*»•*»***•**»•«»•»••• SUBROUTINE ROSTERS »**♦»*#•»»**»**«»##««♦♦* 



GENHQL PROGRAM PROPER. ... 48 
NEEDS FSRS - (EXEM) 458, (IOHI 1016, (IOSI 87, (IOU» 24, 

CTESI 1, DUMP 177, EXIT 17 1780 

STORAGE TOTAL.... 1828 

GETHOL PROGRAM PROPER.... 169 

NEEDS SRS - REVERS 29 29 

AND FSRS * XLOC 12 • 12 

STORAGE TOTAL.... 210 

GETRD1 PROGRAM PROPER.... 229 

NEEDS SRS - REREAD 114 114 

AND FSRS - (EXEM) 458, (IOH) 1016, (IOS) 87, UOUI 24, 

(RER) 37, (TES) 1, DUMP 177, EXIT 17 .... 1817 

STORAGE TOTAL.... 2160 

GETX NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 31 

GNFLT1 PROGRAM PROPER.... 232 

NEEDS FSRS - COS 105 105 

STORAGE TOTAL.... 337 

GNH0L2 PROGRAM PROPER.... 74 
NEEDS FSRS - C EXEM) 458, (IOH) 1016, (IOS) 87, (IOU) 24, 

(TES) 1, DUMP 177, EXIT 17 1780 

STORAGE TOTAL.... 1854 

GRAPH PROGRAM PROPER.... 1499 
NEEDS SRS - DISPLA 219, DSPFMT 194, FLOATM 25, FRAME 9, 
HSTPLT 145, LINE 95, LINEH 35, LINEV 35, 

MVBLOK 19, SCPSCL 33, XFIXM 31 840 

AND FSRS - (EXEM) 458, (IOH) 1016, (IOS) 87, (IOU) 24, 
(SPH) 183, (TES) 1, DUMP 177, EXIT 17, 

EXP(2 38, LOG 53, XLOC 12 .♦ 2066 

STORAGE TOTAL.... 4405 

GRAPHX PROGRAM PROPER.... 123 
NEEDS SRS - DISPLA 219, DSPFMT 194, FLOATM 25, FRAME 9, 
GRAPH 1499, HSTPLT 145, LINE 95, LINEH 35, 

LINEV 35, MVBLOK 19, SCPSCL 33, XFIXM 31 .... 2339 
AND FSRS - (EXEM) 458, (IOH) 1016, (IOS) 87, (IOU) 24, 
(SPH) 183, (TESI 1, DUMP 177, EXIT 17, 

EXP(2 38, LOG 53, XLOC 12 2066 

STORAGE TOTAL.... 4528 

GRUP2 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 201 
HALVL (SECONDARY ENTRY OF DUBLX ) 
HALVX (SECONDARY ENTRY OF DUBLX ) 



HLADJ 



NEEDS NO LOWER ROUTINES 



STORAGE TOTAL.. 



46 



•*»»**•»•»*»*»»••#*»*••» SUBROUTINE ROSTERS #»*#**##»»»###♦#***«#»*# 



HRAOJ (SECONDARY ENTRY OF HLADJ I 

HSTPLT PROGRAM PROPER. • • • 145 

NEEDS SRS - LINEH 35, LINEV 35 ................... 70 

STORAGE TOTAL.... 215 

HVTOIV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 39 

IABS PROGRAM PROPER.... 21 

NEEDS FSRS - SQRT 44 44 

STORAGE TOTAL.... 65 

ICOS (SECONDARY ENTRY OF ISIN ) 

IDERIV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 54 

IEXP NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 157 

IEXP(2 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 161 

IFNCTN PROGRAM PROPER.... 208 

NEEDS SRS - MONOCK 48, REVER 30 78 

STORAGE TOTAL.... 286 

IGETX (SECONDARY ENTRY OF GETX I 

IINTGR NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 49 

ILOG NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 190 

INDATA PROGRAM PROPER.... 896 
NEEDS SRS - FAPSUM 14, FSKIP 50, LOC 4, MV8L0K 19, 

ONLINE 134, SAME 1, UNPAKN 78, VARARG 44 .... 344 
AND FSRS - (EXEMI 458, (108) 570, (IOH) 1016, (IOS) 87, 
(IOU) 24, (RER) 37, (SPH) 183, (TES) 1, 

( TSB ) 66, (WER) 57, DUMP 177, EXIT 17 .... 2693 

STORAGE TOTAL.... 3933 

INDEX NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 50 

INTGRA NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 47 

INTHOL PROGRAM PROPER.... 72 

NEEDS SRS - FNDFMT 88, REVER 30 118 

AND FSRS - (EXEMI 458, (IOHI 1016, (IOS) 87, (IOUI 24, 

(TES) 1, DUMP 177, EXIT 17 1780 

STORAGE TOTAL.... 1970 

INTMSB (SECONDARY ENTRY OF TIMSUB) 

INTOPR NEEDS NO LOWER ROUTINES STORAGE TOTAL.... Ill 

INTSUM NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 27 
IOER (SECONDARY ENTRY CF ( EXEM) ) 



•*»*»••*#»»»»••»*•••«•»» 

» IPLYEV TO LSL INE * 
•**»•**••*»»»»•*«**•»**• 



SUBROUTINE ROSTERS 



» IPLYEV TO LSI INE # 
»••*•»••••*«••*«•*•*•••* 



IPLYEV PROGRAM PROPER.... 98 

NEEDS FSRS - (IFMP) 136 136 

STORAGE TOTAL.... 234 

ISIN NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 184 

ISQRT NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 88 

ITOMLI NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 37 

IVTOHV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 70 

IXCARG PROGRAM PROPER.... 35 

NEEDS FSRS - XLOC 12 12 

STORAGE TOTAL.... 47 

KIINT1 PROGRAM PROPER.... 191 

NEEDS SRS - LINTR1 96 f N0INT1 369 465 

AND FSRS - EXP(3 93 f SQRT 44 137 

STORAGE TOTAL.... 793 

KOLAPS NEEDS NO LOWER ROUTINES STORAGE TOTAL.... ICO 

LIMITS NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 44 

LINE NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 95 

LINEH NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 35 

LINEV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 35 

L1NTR1 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 96 

LISTNG PROGRAM PROPER.... 755 
NEEDS SRS - FAPSUM 14 f FSKIP 50, ONLINE 134, SAME 1, 

SHFTR2 72 271 

AND FSRS - (EXEMI 458, (IOBI 570, i IOH) 1016, UOS) 87, 
UOU) 24, (RER ) 37, (RWT) 7, <SPHI 183, 
<TES> 1, ( TSB ) 66, (WER) 57, DUMP 177, 

EXIT 17 2700 

STORAGE TOTAL.... 3726 

LOC NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 4 

LOCATE NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 512 

LOG NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 53 
L0G10 (SECONDARY ENTRY CF LOG I 

LSHFT NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 12 

LSL INE NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 117 



••»•••••••*•••»»«•»•»•»* SUBROUTINE ROSTERS 

» LSSS1 TO MINSN * 
•*»•»••••»«•••»»•»•«»••* 



•**•*•*••«•**«*•#**#«*•** 

* LSSS1 TO MINSN » 
•••«••»••••»•*•*••**•••* 



LSSS1 PROGRAM PROPER.... 122 

NEEDS SRS - FOOT 40 40 

STORAGE TOTAL.... 162 

MATINV PROGRAM PROPER.... 90 

NEEDS SRS - SIMEQ 441 441 

STORAGE TOTAL.... 531 

MATML1 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 61 

MATML3 PROGRAM PROPER.... 120 

NEEDS SRS - DOTJ 59 59 

STORAGE TOTAL.... 179 

MATRA NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 92 

MATRA1 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 42 
MAXAB (SECONDARY ENTRY OF MAXSN I 
MAXABM (SECONOARY ENTRY OF MAXSNM* 

MAXSN NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 54 

MAXSNM NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 61 

MDOT PROGRAM PROPER.... 1C9 

NEEDS SRS - MATML1 61 • • 61 

STORAGE TOTAL.... 170 

MD0T3 PROGRAM PROPER.... 122 

NEEDS SRS - DOTJ 59, MATML3 120 179 

STORAGE TOTAL.... 301 

MEMUSE PROGRAM PROPER.... 71 

NEEDS SRS - ONLINE 134, XLCOMN 14 148 

AND FSRS - (EXEM) 458, (IOHl 1016, (IOSI 87, UQUI 24, 
(SPH) 183, CTESI 1, tWERI 57, DUMP 177, 

EXIT 17 2020 

STORAGE TOTAL.... 2239 

MFACT PROGRAM PROPER.... 187 

NEEDS SRS - DOTJ 59, STZ 14 73 

AND FSRS - SORT 44 44 

STORAGE TOTAL.... 304 

MIFLS PROGRAM PROPER.... 276 

NEEDS SRS - DOTJ 59, MATML3 120, MOVREV 74 253 

STORAGE TOTAL.... 529 

MINAB (SECONDARY ENTRY OF MAXSN ) 
MINABM (SECONDARY ENTRY OF MAXSNM) 
MINSN (SECONDARY ENTRY OF MAXSN I 



**•**•••»*•*•»**»«••***• SUBROUT INE 

* MINSNM TO MULKS * 
****•»••*»**•»** »•*«**** 



ROSTERS *•*»**»•*•**•»**••*•••** 
* MINSNM TO MULKS « 
«•»••»•»*••••••»•**«««»« 



MINSNM (SECONOARY ENTRY OF MAXSNM* 



MI PLS 

NEEOS 


SRS - 




DOTJ 
MATRA 
STZ 
XLOC 


59, 
92, 


IXCARG 
MD0T3 


35, 
122, 


MATINV 
MOVREV 


PROGRAM PROPER. ... 
90, MATML3 120, 
74, SIMEQ 441, 


571 

1047 
12 
1630 


a Kin 
AND 


r SRS - 
























STORAGE TOTAL.... 


MISS 
NEEDS 


SRS - 




DOTJ 


59, 


MATML3 


120, 


MOOT 3 


PROGRAM PROPER.... 
122, MOVREV 74 .... 
STORAGE TOTAI---- 


335 
375 
710 


MLI SCL 


NEEDS 


Kin 
NO 


LOWER ROUTINES 








STORAGE TOTAL. ... 


47 


MLI2A6 


NEEOS 


NO 


LOWER ROUTINES 








STORAGE TOTAL.... 


128 




NEEDS 


NO 


LOWER ROUTINES 










48 


MOUT 
NEEDS 
ANO 


SRS - 
FSRS - 




CARIGE 
(EXEM) 
(SPH> 
EXIT 


47, 
458, 
183, 


ONLINE 
( IOHI 
(TES> 


134 < 
1016, 
1, 




PROGRAM PROPER.... 


130 
181 

2020 
2331 




( IOSI 
( WERI 


87, (IQU1 24, 
57, DUMP 177, 
















STORAGE TOTAL. ... 


MOUTAI 

NEEDS 


SRS - 




CARIGE 
MOVE 
SAME 

(EXEM) 
(SPHJ 
EXIT 


47, 

32, 


FIXV 
MULPLY 


35, 
34, 


GNH0L2 
ONLINE 


DDfirDAM DDHDCD 
rKUuKAn rKUrtrv.... 

74, MAXSNM 61, 
134, RNO 15, 


357 

433 

2111 
2901 


AND 


FSRS 




458, 
183, 
17, 


(IOHI 
(TES) 
EXP ( 2 


1016, 
1, 
38, 


( IOSI 
( WER ) 
LOG 


87, CIOUI 24, 
57, DUMP 177, 








STORAGE TOTAL.... 


MOVE 


NEEDS 


NO 


LOWER ROUTINES 








STORAGE TOTAL.... 


32 


MOVECS 
NEEDS 


SRS - 




MOVE 










PROGRAM PROPER.... 


24 
32 
56 












STORAGE TOTAL.... 


MOVREV 


NEEDS 


NO 


LOWER ROUTINES 








STORAGE TOTAL.... 


74 


MPSEQi 


NEEOS 


NO 


LOWER ROUTINES 








STORAGE TOTAL.... 


110 


MRVRS 
NEEDS 


SRS - 




REVERS 










PROGRAM PROPER.... 


61 
29 
90 












STORAGE TOTAL.... 


MSCON1 


NEEDS 


NO 


LOWER ROUTINES 








STORAGE TOTAL.... 


238 



MULK (SECONDARY ENTRY OF ADDK ) 



MULKS 



(SECONDARY ENTRY OF ADDK > 



*••»***•*****•»•*•»**•** 

» MULLER TO ONLINE « 
*»•»•»••»*•«•*•••»*•«*»• 



SUBROUTINE ROSTERS 



••*••»*•••••••«•»••*•*•• 

» MULLER TO ONLINE * 
•*••»»»••»»•*»**»•*•••** 



MULLER PROGRAM PROPER,.*. 757 

NEEDS FSRS - SORT 44 .............. 44 

STORAGE TOTAL.... 801 

MULPLY NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 34 

MUVADD NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 129 

MVBLOK NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 19 

MVINAV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 221 

MVNSUM NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 71 

MVNTIN NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 88 
MVNTNA (SECONDARY ENTRY OF MVNTIN) 

MVSQAV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 236 

MXRARE PROGRAM PROPER.... 302 

NEEDS FSRS - EXP(2 38 o ........ . 38 

STORAGE TOTAL.... 340 

NEXCOS (SECONDARY ENTRY OF SEQSAC) 
NEXSIN (SECONDARY ENTRY OF SEQSACI 

NMZMG1 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 34 

NOINT1 PROGRAM PROPER.... 369 

NEEDS SRS - LINTR1 96 96 

STORAGE TOTAL.... 465 

NOINT2 (SECONDARY ENTRY OF NOINT1I 

NRMVEC PROGRAM PROPER.... Ill 

NEEDS SRS - MAXSN 54 54 

AND FSRS - SORT 44 44 

STORAGE TOTAL.... 209 

NTHA NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 11 

NURINC NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 121 

NXALRM PROGRAM PROPER.... 243 

NEEDS SRS - FASCN1 107 107 

STORAGE TOTAL.... 350 

ONLINE PROGRAM PROPER.... 134 
NEEDS FSRS - (EXEMI 458, (IOH> 1016, (IOSI 87, (IOUI 24, 
(SPH) 183, (TES ) 1, (WER> 57, DUMP 177, 

EXIT 17 2020 

STORAGE TOTAL.... 2154 



»***•»»••»»*»•****••••»• 

« OUOATA TO PLYSYN » 
«***••*•*•*»*•»*•*•«•**» 



SUBROUTINE ROSTERS 



•»**»•«*«•»*••*•*•«•*•«» 

» OUOATA TO PLYSYN • 
«»«•»*•••••*»•«•*•••*«*» 



OUDATA PROGRAM PROPER. •.. 495 

NEEDS SRS - FAPSUM 14, FXDATA 102, LOC 4, MVBLOK 19, 

PAKN 78, VARARG 44 ..... 261 

AND FSRS - C EFT) 7, (EXEM) 458, (IOB) 570, (IOS) 87, 

(IOU) 24, (STB) 53, (TES) 1, CWER) 57, 

DUMP 177, EXIT 17 1451 

STORAGE TOTAL.... 2207 

PACDAT PROGRAM PROPER.... 152 

NEEDS FSRS - (EXEM) 458, ( IOS) 87, (IOU) 24, (TES) 1, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 916 

PAKN PROGRAM PROPER.... 78 

NEEDS SRS - FXDATA 102 • • • •• 102 

STORAGE TOTAL.... 180 

PDUMP (SECONDARY ENTRY OF DUMP ) 

PLANSP PROGRAM PROPER.... 1169 

NEEDS SRS - ADDK 114, CHOOSE 17, CHPRTS 76, COSISl 406, 

COSP 504, COSTBL 121, IXCARG 35, KOLAPS 100, 
LIMITS 44, MATRA 92, MOVREV 74, REVERS 29, 
R0AR2 174, SETK 37, SPLIT 224, STZ 14, 

XOOZE 4 • 2065 

AND FSRS - COS 105, XLOC 12 117 

STORAGE TOTAL.... 3351 

PLOTVS PROGRAM PROPER.... 494 

NEEDS SRS - ONLINE 134, RND 15, SETK 37, SETKV 15, 

SWITCH 15 216 

AND FSRS - (EXEM) 458, (IOH) 1016, (IOS) 87, (IOU) 24, 
(SPH) 183, (TES) 1, (WER) 57, OUMP 177, 

EXIT 17 2020 

STORAGE TOTAL.... 2730 

PLTVS1 PROGRAM PROPER.... 817 

NEEDS SRS - BOOST 34, MAXSN 54, MULPLY 34, ONLINE 134, 

PLOTVS 494, RMSDEV 50, RND 15, SAME 1, 
SETK 37, SETKV 15, SETKVS 25, SETLIN 27, 

SWITCH 15, VARARG 44 979 

AND FSRS - (EXEM) 458, (IOH) 1016, (IOS) 87, (IOU) 24, 
(SPHI 183, (TES) 1, (WER) 57, OUMP 177, 

EXIT 17, SORT 44, XLOC 12 2076 

STORAGE TOTAL.... 3872 

PLURAL (SECONDARY ENTRY OF SEVRAL) 

PLURNS NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 73 

PLYSYN PROGRAM PROPER.... 172 

NEEDS SRS - CONVLV 56 56 

AND FSRS - COS 105 • 105 

STORAGE TOTAL.... 333 



• P0KCT1 TO QFURRY * 



SUBROUTINE ROSTERS 



*•»•»*• ••*»•••* 

♦ POKCT1 TO QFURRY * 
•*•*»***••••••»#••***« t# 



POKCT1 

NEEDS SRS 



POLYDV 

NEEOS SRS 



PQLYEV NEEDS 

POLYSN 

NEEDS SRS - 
AND FSRS - 



POWER 

NEEDS FSRS 



PRBFIT 

NEEDS FSRS 



PROB2 NEEDS 

PROCOR NEEDS 

PSQRT 

NEEDS FSRS - 



PWMLIV 

NEEDS SRS 
AND FSRS 



QACORR 

NEEDS SRS 



QCNVLV 

NEEDS SRS 
AND FSRS 



QFURRY 

NEEDS SRS - 

AND FSRS - 



PROGRAM PROPER.... 219 

FRQCT1 117 117 

STORAGE TOTAL.... 336 

PROGRAM PROPER. ... 130 

MOVE 32, STZ 14 46 

STORAGE TOTAL.... 176 

NO LOWER ROUTINES STORAGE TOTAL.... 54 

PROGRAM PROPER.... 256 

CONVLV 56, MOVE 32 • • 88 

COS 105» SQRT 44 149 

STORAGE TOTAL.... 493 

PROGRAM PROPER.... 50 

EXP( 2 38 • 38 

STORAGE TOTAL.... 88 

PROGRAM PROPER.... 373 

EXP 52, EXP<2 38, SQRT 44 134 

STORAGE TOTAL.... 507 

NO LOWER ROUTINES STORAGE TOTAL.... 229 

NO LOWER ROUTINES STORAGE TOTAL.... 770 

PROGRAM PROPER.... 155 

SQRT 44 •• 44 

STORAGE TOTAL.... 199 

PROGRAM PROPER.... 300 

MLI2A6 128, ONLINE 134 262 

(EXEM) 458, UOH) 1016, (IOSI 87, CIOU) 24, 
<SPH) 183, ( TES ) 1, (WER) 57, DUMP 177, 

EXIT 17 • • 2020 

STORAGE TOTAL.... 2582 

PROGRAM PROPER.... 207 

FXDATA 102, PROCOR 770 872 

STORAGE TOTAL.... 1079 

PROGRAM PROPER.... 569 

FXOATA 102, PROCOR 770 872 

XLOC 12 • 12 

STORAGE TOTAL.... 1453 

PROGRAM PROPER.... 244 
CHPRTS 76, COSP 504, COSTBL 121, KOLAPS 100, 

MOVE 32, SPLIT 224, STZ 14, XSPECT 523 .... 1594 

COS 105, XLOC 12 117 

STORAGE TOTAL.... 1955 



•*»»•****»*»*•»•••»•**•• 

* QIFURY TO RLSPR * 



SUBROUTINE ROSTERS 



*•»*»»*«»»*«»**•*»*•*«»• 

« QIFURY TO RLSPR m 
••••»»•*»••**•*«••*«•«*• 



QIFURY PROGRAM PROPER.... 280 

NEEDS SRS • COSP 504, COSTBL 121 625 

AND FSRS - COS 105 f XLOC 12 .. 117 

STORAGE TOTAL... 1022 

QINTR1 PROGRAM PROPER.... 229 

NEEDS SRS - QUFIT1 79, RND 15 94 

STORAGE TOTAL.... 323 

QUFIT1 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 79 

QXCORR PROGRAM PROPER.... 283 

NEEDS SRS - FXDATA 102, PROCOR 770 872 

AND FSRS - XLOC 12 12 

STORAGE TOTAL.... 1167 

QXC0R1 PROGRAM PROPER.... 502 
NEEDS SRS - IXCARG. 35, LIMITS 44, PROCOR 770, REVERS 29, 

SETK 37, STZ 14 929 

AND FSRS - XLOC 12 12 

STORAGE TOTAL.... 1443 

RDATA PROGRAM PROPER.... 645 
NEEDS SRS - CMPRA 18, FNDFMT 88, HVTOIV 39, INTHOL 72, 
IVTOHV 70, IXCARG 35, LOCATE 512, ONLINE 134, 

REREAD 114, REVER 30 1112 

AND FSRS - (EXEM) 458, (IOH) 1016, (IOS) 87, IIOU) 24, 
(RER) 37, (SPH) 183, (TES) 1, CWER) 57, 

DUMP 177, EXIT 17, XLOC 12 2069 

STORAGE TOTAL.... 3826 

REFIT (SECONDARY ENTRY OF SPLIT ) 

REFLEC NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 28 
REIM ( SECONDARY ENTRY OF AMPHZ * 

REMAV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 36 

REREAD PROGRAM PROPER.... 114 
NEEDS FSRS - (EXEM) 458, (IOH) 1016, (IOS) 87, (IOU) 24, 

(RER) 37, ( TES ) 1, DUMP 177, EXIT 17 .... 1817 

STORAGE TOTAL.... 1931 

RETURN (SECONDARY ENTRY OF LOCATE) 

REVER NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 30 

REVERS NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 29 

RLSPR PROGRAM PROPER.... 142 

NEEDS SRS - FOOT 40 40 

STORAGE TOTAL.... 182 



**»*»*»•*«•»*»»*»•«*«»•* SUBROUTINE ROSTERS »««*••••*»••••»«•»##•*•» 

* RLSPR2 TO SETAPT « * RLSPR2 TO SETAPT • 

****»»»*»•«*•*•#»*•••*•• ••••»•• •»»••••»«••« ••••^» 

RLSPR2 PROGRAM PROPER.... 700 
NEEOS SRS - DOTJ 59, DOTP 264, IXCAR6 35, MATML3 120, 

MOVREV 74, SIMEQ 441, STZ 14 1007 

AND FSRS - XLOC 12 12 

STORAGE TOTAL.... 1719 

RLSSR PROGRAM PROPER.... 82 

NEEOS SRS - FDOT 40 40 

STORAGE TOTAL.... 122 

RMSDAY (SECONDARY ENTRY OF RMSDEVI 

RMSDEV PROGRAM PROPER.... 50 

NEEOS FSRS - SORT 44 44 

STORAGE TOTAL.... 94 

RND NEEOS NO LOWER ROUTINES STORAGE TOTAL.... 15 
RNODN (SECONDARY ENTRY CF RND I 
RNDUP (SECONDARY ENTRY OF RND ) 

RNDV PROGRAM PROPER.... 34 

NEEDS SRS - RND 15 15 

STORAGE TOTAL.... 49 

RNDVDN (SECONOARY ENTRY OF RNDV I 
RNDVUP (SECONDARY ENTRY OF RNDV ) 

R0AR2 PROGRAM PROPER.... 174 

NEEOS SRS - MATRA 92, MOVREV 74, REVERS 29 195 

STORAGE TOTAL.... 369 

ROTATi NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 46 

RPLFMT NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 17 

RSKIP PROGRAM PROPER.... 37 
NEEDS FSRS - ( EXEM) 458, ( IOSI 87, ( IOUI 24, (TESI I, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 801 

RVPRTS (SECONDARY ENTRY OF CHPRTS I 

SAME NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 1 

SCPSCL NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 33 

SEARCH NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 25 

SEQSAC PROGRAM PRGPER. • • • 94 

NEEDS FSRS - COS 105 105 

STORAGE TOTAL.... 199 

SETAPT (SECONDARY ENTRY OF INDEX ) 



•»••**••»•**•*•»**•*•*•• 

• SETEST TO SINTBL » 



SUBROUTINE ROSTERS •••••»«*#»•«•*•«••#«**•* 

» SETEST TO SINTBL • 



SETEST CSECONOARY ENTRY OF INDEX I 

SETINO PROGRAM PROPER.... 84 

NEEDS SRS - FSKIP 50, XLIMIT 25 ..... 75 

AND FSRS - ( EXEM) 458, (IOB) 570, (IOS) 87, (IQU) 24, 
(RERI 37, (RWTI 7, CTESI 1, (TSBI 66, 

DUMP 177, EXIT 17 ... 1444 

STORAGE TOTAL.. 1603 

SETK NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 37 

SETKP PROGRAM PROPER.... 40 

NEEDS SRS - SETK 37 37 

STORAGE TOTAL.... 77 

SETKS (SECONDARY ENTRY OF SETK > 

SETKV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 15 

SETKVS NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 25 

SETLIN NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 27 

SETLNS PROGRAM PROPER.... 39 

NEEDS SRS - SETLIN 27 27 

STORAGE TOTAL.... 66 

SETSBV (SECONDARY ENTRY OF LOCATE) 
SETUP (SECONDARY ENTRY OF LOCATE I 
SETVCP (SECONDARY ENTRY CF SETKP ) 
SETVEC (SECONDARY ENTRY OF SETK I 

SEVRAL PROGRAM PROPER.... 416 

NEEDS SRS - LOCATE 512 512 

STORAGE TOTAL.... 928 

SHFTR1 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 70 

SHFTR2 NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 72 

SHUFFL PROGRAM PROPER.... 101 

NEEDS SRS - GETRD1 229, REREAD 114, SEARCH 25, SIZEUP 136 .... 504 
AND FSRS - (EXEM) 458, ( IOHI 1016, (IOSI 87, (IOUI 24, 

(RFR) 37, (TES* 1, DUMP 177, EXIT 17 .... 1817 

STORAGE TOTAL.... 2422 

SIFT NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 30 

SIMEQ NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 441 
SIN (SECONDARY ENTRY OF COS I 
SINTBL (SECONDARY ENTRY OF COSTBL) 



»»*»•»••*•*•*••*»*••*••• SUBROUTINE ROSTERS 

* SINTBX TO SUBKS » 



»••••»»•«*•••»»»••*«»•»• 

* SINTBX TO SUBKS • 
»•*•** *»*•»»»»** • **«•••* 



SINTBX ( SECONOARY ENTRY OF COSTBLl 

SISP I SECONDARY ENTRY OF COSP ) 

SIZEUP NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 136 

SIZUPL (SECONDARY ENTRY OF SIZEUP) 

SMPRDV (SECONDARY ENTRY OF POWER I 

SMPSON NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 317 

SPCOR2 PROGRAM PROPER.... 291 
NEEDS SRS - FXDATA 102, IXCARG 35, LIMITS 44, PROCOR 770, 

QXC0R1 502, REVERS 29, SETK 37, STZ 14 .... 1533 

AND FSRS - XLOC 12 12 

STORAGE TOTAL.... 1836 

SPLIT NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 224 
SQRDEV (SECONDARY ENTRY OF SQRDFR I 

SQRDFR NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 36 

SQRMLI NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 55 

SQROOT PROGRAM PROPER.... 24 

NEEDS FSRS - SQRT 44 44 

STORAGE TOTAL.... 68 

SQRSUM NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 36 

SQRT NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 44 

SQUARE NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 32 

SRCH1 PROGRAM PROPER.... 93 

NEEDS SRS - XACTEQ 11 11 

STORAGE TOTAL.... 104 

STEPC (SECONDARY ENTRY OF DELTA I 
STEPL (SECONDARY ENTRY OF DELTA ) 
STEPR (SECONDARY ENTRY OF DELTA I 
STORE (SECONDARY ENTRY OF LOCATE) 

STZ NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 14 

STZS NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 24 

SUBK (SECONDARY ENTRY OF ADDK i 
SUBKS (SECONDARY ENTRY CF ADDK ) 



***»••*•**»•***••*••»*•* 

« SUM TO VMNUSV * 

***»*»#•*«•»»*•*»»**•*•* 



SUBROUTINE ROSTERS 



•*»••»•«»*»«•»••••••»«•• 

* SUM TO VMNUSV * 

•*••••**»•**•»*«•«»«*•*• 



SUM NEEDS NO LOWER ROUTINES STORAGE TOTAL...* 23 
SUMOEV (SECONDARY ENTRY OF SUMDFR ) 

SUMDFR NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 44 

SWITCH NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 15 

TAMVL NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 63 
TAMVR (SECONDARY ENTRY OF TAMVL ) 

TANH NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 86 

TIMA2B NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 124 

TIMSUB PROGRAM PROPER.... 229 

NEEDS SRS - TIMA2B 124 124 

STORAGE TOTAL.... 353 

TINGL NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 43 
TINGLA (SECONDARY ENTRY OF TINGL ) 

TRMINO PROGRAM PROPER.... 67 
NEEDS SRS - FAPSUM 14, FSKIP 50, FXDATA 102, LOC 4, 
MVBLOK 19, OUDATA 495, PAKN 78, VARARG 44, 

XLIMIT 25 831 

AND FSRS - (EFT! 7, (EXEM) 458, CIOBI 570, (IOSI 87, 

UOU) 24, (RWT) 7, (STB) 53, (TES) 1, 

(WER) 57, DUMP 177, EXIT 17 1458 

STORAGE TOTAL.... 2356 

UNPAKN NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 78 

VARARG NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 44 

VDOTV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 25 

VDVBYV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 22 

VECOUT PROGRAM PROPER.... 66 

NEEDS SRS - FNDFMT 88, ONLINE 134, REVER 30, RPLFMT 17 .... 269 
AND FSRS - (EXEM) 458, ( IOHI 1016, (IOSI 87, (IOUI 24, 
(SPH) 183, (TES) 1, (WER) 57, DUMP 177, 

EXIT 17 • 2020 

STORAGE TOTAL.... 2355 

VINDEX (SECONDARY ENTRY OF INDEX ) 
VMNUSV (SECONDARY ENTRY OF VPLUSV) 



**»*•»»«•***••***#•*»«•• SUBROUTINE ROSTERS «•••**••••••*••#••«••••# 

* VOUT TO XBOOST * # VOUT TO XBOOST * 

•**»«**•»••*•*•••*••*••• •«*»•••«»•*•••••«*•«*••!• 

VOUT PROGRAM PROPER.... 104 

NEEDS SRS - CARIGE 47, FNDFMT 88 f HLADJ 46, ONLINE 134, 

REVER 30, RPLFMT 17, VECOUT 66 428 

AND FSRS - (EXEMI 458, (IOHI 1016, (IOSI 87, (IOUI 24, 
(SPHI 183, (TESI 1, (WERI 57, DUMP 177, 

EXIT 17 2020 

STORAGE TOTAL.... 2552 

VPLUSV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 34 

VRSOUT PROGRAM PROPER.... 47 

NEEDS SRS - CARIGE 47, FNDFMT 88, ONLINE 134, REVER 30, 

RPLFMT 17, VECOUT 66 382 

AND FSRS - (EXEM) 458, UOH) 1016, (IOSI 87, (IOUI 24, 
(SPH) 183, (TES) 1, (WER) 57, DUMP 177, 

EXIT 17 2020 

STORAGE TOTAL.... 2449 

VSOUT PROGRAM PROPER.... 37 

NEEDS SRS - CARIGE 47, FNDFMT 88, HLADJ 46, ONLINE 134, 

REVER 30, RPLFMT 17, VECOUT 66, VOUT 104 .... 532 
AND FSRS - (EXEM) 458, UOH) 1016, (IOS) 87, (IOU) 24, 
(SPH) 183, CTES) 1, (WER) 57, DUMP 177, 

EXIT 17 •••••• • •• 2020 

STORAGE TOTAL.... 2589 

VTIMSV NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 34 

WAC NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 107 

WHERE (SECONDARY ENTRY OF LOCATE) 

WHICH NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 4 

WLLSFP PROGRAM PROPER.... 216 

NEEDS SRS - FDOT 40, MOVE 32 72 

STORAGE TOTAL.... 288 

WRTDAT PROGRAM PROPER.... 77 
NEEDS FSRS - (EXEM) 458, (IOSI 87, (IOUI 24, (TESI 1, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 841 

XACTEQ NEEDS NO LOWER ROUTINES STORAGE TOTAL.... 11 
XADDK (SECONDARY ENTRY OF A DDK ) 
XADDKS (SECONDARY ENTRY OF ADDK ) 
XARG (SECONDARY ENTRY OF LOCATE) 

XAVRGE PROGRAM PROPER.... 34 

NEEDS SRS - XDIV 27 27 

STORAGE TOTAL.... 61 

XAVRGR (SECONOARY ENTRY OF XAVRGE I 



XBOOST (SECONDARY ENTRY OF BOOST ) 



«•*»••*••»•**•••••*«••«• SUBROUTINE ROSTERS 

• XCMPRA TO XNTHA * 



»»»•»»»«•«••*•••«••••••« 

« XCMPRA TO XNTHA » 
••*••** ••*•-»••«»*** $ ••**** 



XCMPRA 

XDANL 

XOANX 

XDELTA 

XDFPRS 

XDIV 

XDIVK 

XDIVKS 

XDIVR 

XDPRSS 

XOVIDE 



(SECONDARY ENTRY OF CMPRA I 
(SECONOARY ENTRY OF ADANL ) 
(SECONDARY ENTRY OF ADANL 1 
(SECONDARY ENTRY OF DELTA ) 
(SECONDARY ENTRY OF DIFPRSI 
NEEDS NO LOWER ROUTINES 
(SECONDARY ENTRY OF ADDK I 
(SECONDARY ENTRY OF ADDK ) 
(SECONDARY ENTRY OF XDIV 1 
(SECONDARY ENTRY OF BOOST ) 



STORAGE TOTAL. 



PROGRAM PROPER. 



27 



33 



NEEDS 


SRS - 


XDIV 








27 






€ TflO A/* C 


1 U 1 AL. ... 


XDVIDR 


(SECONDARY 


ENTRY 


OF 


XDVIDEI 








XDVRK 


(SECONDARY 


ENTRY 


OF 


ADDK ) 








XDVRKS 


(SECONDARY 


ENTRY 


OF 


ADDK 1 








XFIXM 


NEEDS NO LOWER ROUTINES 


STORAGE 


TOTAL.... 


31 


XINDEX 


(SECONDARY 


ENTRY 


OF 


LOCATE 1 








XLCOMN 


NEEDS NO LOWER ROUTINES 


STORAGE 


TOTAL.... 


14 


XLIMIT 


NEEDS NO LOWER ROUTINES 


STORAGE 


TOTAL.... 


25 


XLOC 


NEEDS NO LOWER ROUTINES 


STORAGE 


TOTAL.... 


12 


XLOCV 


NEEDS NO LOWER ROUTINES 


STORAGE 


TOTAL.... 


24 


XLSHFT 


(SECONDARY 


ENTRY 


CF 


LSHFT } 








XMLPLY 


(SECONDARY 


ENTRY 


CF 


MULPLYI 








XMULK 


(SECONDARY 


ENTRY 


OF 


ADDK ) 








XMULKS 


(SECONDARY 


ENTRY 


OF 


ADDK ) 








XNAME 


(SECONDARY 


ENTRY 


OF 


LOCATE) 








XNARGS 


(SECONDARY 


ENTRY 


CF 


LOCATE) 








XNTHA 


(SECONDARY 


ENTRY 


CF 


NTHA ) 









* XNTSUM TO XVMNSV * 



SUBROUTINE ROSTERS 



»»***»*•••*#••••••«*•• «w 

« XNTSUM TO XVMNSV » 



•*••**••****•*•••••»**** 












XNTSUM 


(SECONDARY 


ENTRY 


OF 


INTSUM) 








XOOZE 


NEEDS NO LOWER ROUTINES 




STORAGE TOTAL.. •. 


4 


XREMAV 
NEEDS 


SRS - 


XAVRGE 






PROGRAM PROPER. ... 


31 
61 








STORAGE TOTAL.... 


92 


XRFLEC 


(SECONDARY 


ENTRY 


OF 


REFLEC) 








XSAME 


(SECONDARY 


ENTRY 


CF 


SAME ) 








XSMDEV 


(SECONDARY 


ENTRY 


OF 


SUMDFRI 








XSMDFR 


(SECONDARY 


ENTRY 


OF 


SUMDFR) 








XSPECT 
NEEDS 
AND 


SRS - CHPRTS 
FSRS - XLOC 


76, COSP 


504, KOLAPS 


PROGRAM PROPER.... 
100, SPLIT 224 .... 


523 
904 
12 








STORAGE TOTAL.... 


1439 


XSQDEV 


(SECONDARY 


ENTRY 


OF 


XSQDFR) 








XSQDFR 


NEEDS NO LOWER ROUTINES 




STORAGE TOTAL.... 


37 


XSQRUT 
NEEDS 
AND 


SRS - 
FSRS - 


FIXV 
SORT 






PROGRAM PROPER.... 


37 
35 
44 














STORAGE TOTAL.... 


116 


XSQSUM 


(SECONDARY 


ENTRY 


OF 


SQRSUM) 








XSQUAR 


(SECONDARY 


ENTRY 


OF 


SQUARE) 








XSTEPC 


(SECONDARY 


ENTRY 


GF 


DELTA ) 








XSTEPL 


(SECONDARY 


ENTRY 


OF 


DELTA ) 








XSTEPR 


(SECONDARY 


ENTRY 


OF 


DELTA ) 








XSTLIN 


(SECONDARY 


ENTRY 


OF 


SETLIN) 








XSUBK 


(SECONDARY 


ENTRY 


CF 


ADDK ) 








XSUBKS 


(SECONDARY 


ENTRY 


OF 


ADDK ) 








XSUM 


(SECONDARY 


ENTRY 


CF 


SUM ) 








XVDRBV 


(SECONDARY 


ENTRY 


OF 


XVDVBV) 








XVDVBV 

NEEDS 


SRS - 


XDIV 






PROGRAM PROPER.... 


34 
27 








STORAGE TOTAL.... 


61 



XVMNSV (SECONDARY ENTRY GF VPLUSV) 



»*»***»•**«»«•»•••»•**•* 

• XVPLSV TO ZEF8IN * 
•**•*•****•*«•**•••*•*** 



SUBROUTINE ROSTERS 



*»••»»»«••»*•*»*••*«»«•• 

* XVPLSV TO ZEFBIN » 
*»***»*••»**••••••••*••• 



XVPLSV (SECONDARY ENTRY OF VPLUSVI 

XVTMSV (SECONDARY ENTRY OF VTIMSV) 

XWHICH (SECONDARY ENTRY OF WHICH I 

ZEFBCD PROGRAM PROPER...* 54 

NEEDS FSRS - (EXEM> 458, (IOSI 87, UOU> 24, (TESl 1, 

DUMP 177, EXIT 17 764 

STORAGE TOTAL.... 818 

ZEFBIN (SECONDARY ENTRY OF ZEFBCD I 



io 

Complete 
Program Listings 



The remainder of this volume is devoted to listings of the symbolic card decks of the 
program library. The reproductions shown here have been made by a photo-offset 
process from IBM 1401 printings of magnetic tapes produced by a formating program 
whose inputs were master tapes (their development is discussed below) containing 
the symbolic decks. The function of the formating program was merely to paginate 
the source decks and provide headings for dictionary-style access. The program decks 
on the master symbolic tape are serialized (in columns 76 through 79) in a manner 
evident from the listings of this section, and the normal page divisions are made every 
75 cards. Some of the pages, however, contain fewer than 75 cards. This does not 
imply the accidental appearance of blank cards on the source tape but rather is a side 
effect of page division rules used by the formating program to avoid a splitting of 
photograph inserts (as occur in GRAPH, LINE, HSTPLT, etc.) between pages. (The 
obscured portions of the cards used as spacers for the photographic inserts are blank 
except for instructions concerning the size of prints to be inserted.) 

The visual distinctions in the listings between l's andFs and between O's and 
O's are occasionally troublesome, but one gets adept in these discriminations after a 
while. As a general rule we try to avoid the use of names composed of letter-number 
mixtures except where the number is terminal. Even in these cases, if the context 
demands a name with a terminal zero we often substitute the character Z. 

The majority of cards in the symbolic decks are devoted to program description. 
The general card format adhered to has been as shown in Table 1 below, with simple 
modifications in the cases of multiple-entry programs. 

Although the format details will be apparent from the cards, a few comments 
are in order. Note that the program name always appears starting in column 2 of the 
third card of each deck. There is some inconsistency in the abstracts — the older 
programs adjust comments into column 15, newer ones into column 16. Under "equip- 
ment" many of the older programs state "709 or 7090. " These programs also work 
on the 7094. Storage requirements are given in decimal. For FORTRAN programs 
these requirements will depend to some extent on the compiling system used. The 
numbers given here are storage lengths as compiled by the system described in Sec- 
tion 1. In those cases where the examples consist of pairs of descriptions of inputs 
and outputs, one is to infer that the sample CALL statement, as written, is executed 
following the establishment of the inputs. For a discussion of conventions used in 
designing calling sequences turn to Section 4. For sample test programs used to prove 
the examples see Section 2. Section 1 also includes further discussion of notational 
conventions. 
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Time-Series Computations in FORTRAN and FAP 
TABLE 1 



PROLOGUE CARDS 
ABSTRACT 

Discussion of program function 

Language comments 

Equipment needed 

Storage required 

Speed 

Author and date 
Usage 

Transfer vector 

Sample FORTRAN usage statement 

Input descriptions in terms of the sample statement 

Output descriptions in terms of the sample statement 

Examples of usage 
PROGRAM PROPER 
END CARD 



The master symbolic tapes which are the source of the present listings were 
generated under a program-development scheme roughly as follows. 

1. Authors write their own complete programs, including examples. 

2. A test program is written (preferably by a second programmer) to carry out the 
examples. 

3. The program is debugged to the author's satisfaction. 

4. The symbolic decks (program and tester) are added to a batch of programs 
awaiting "acceptance processing.' 9 

5. Acceptance processing, which is carried out when the batch reaches reasonable 
size, comprises the following steps: 

(a) The batch is listed and subjected to format and grammatical editing. 

(b) The program decks are loaded onto tape and serialized onto a second tape. 

(c) The serialized tape is punched to give serialized decks, and compiled to give 
binary decks. 

(d) The serialized decks are collated with the test decks, a " definitive execution" 
is carried out, and the test results are carefully rechecked. 

(e) When all troubles are corrected, the binary program decks from (d) are com- 
pared with those from (c) and then added to the subroutine library, and the 
serialized tape from (b) is added by a merging program to the previously 
developed master symbolic tapes. 

Our experience has been that programs accepted by this process have a high probability 
of working as expected. 
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»**••***••*#•*»*•»*••*•» PROGRAM LISTINGS *#*»****•»»#»#••»**»**#♦ 

• ABSVAL » * ABSVAL • 

«***•*••*••••**«••*»•*•« ••»•*»»•*•••*»••«••*•*** 

* ABSVAL (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0116 

* FAP 0001 
♦ABSVAL 0002 

COUNT 100 0003 

L8L ABSVAL 0004 

ENTRY ABSVAL ( ANYVEC , ILO f IHI , ABS VEC, I ANS ) 0005 

» 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - ABSVAL 0009 

* FAST ABSOLUTE VALUE OF A VECTOR 0010 

* 0011 

* ABSVAL FORMS A VECTOR EQUAL TO THE MAGNITUDE OF A 0012 

* SPECIFIED RANGE OF ANOTHER VECTOR. INPUT VECTOR MAY 0013 
» BE FIXED POINT OR FLOATING POINT. 0014 
« 0015 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0016 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0017 

* STORAGE - 50 REGISTERS 0018 

* SPEED - TAKES 74 + 6*N MACHINE CYCLES ON THE 7090t WHERE 0019 

* N - NO. ELEMENTS IN SPECIFIED RANGE 0020 

* AUTHOR - S.M. SIMPSON JR, JUNE 1962 0021 

* 0022 

* -USAGE 0023 

» 0024 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0025 

* AND FORTRAN SYSTEM ROUflNFS - NONE 0026 

* 0027 

* FORTRAN USAGE 0028 

* CALL ABSVAL (ANYVEC, ILO, IHI, ABS VEC, I ANS ) 0029 
» 0030 

* INPUTS 0031 

* 0032 
» ANYVECU) I=IL0,...,IHI IS THE RANGE (ANYVEC IS FIXED OR FLTG). 0033 

* 0034 

* ILO MUST EXCEED 0. 0035 
» 0036 

* IHI MUST EQUAL OR EXCEED ILO. 0037 

* 0038 

* OUTPUTS 0039 
» 0040 
» ABSVECU) 1 = 1,2,... ,( IHI-ILO+l) CONTAINS 0041 

* MAGNITUDE (ANYVEC (ILO,..., IHI) ). 0042 

* EQUIVALENCE ( ANYVEC ,ABSV£C ) IS PERMITTED. 0043 

* 0044 

* I ANS * 0 MEANS JOB DONfc. 0045 

* =-1 MEANS ILLEGAL ILO OR IHI. 0046 

* 004 7 
» EXAMPLES 0048 

* 0049 

* 1. INPUTS - ANYVEC(l...iO) » -1.0,-2.0,-3.0,... IL0»3 IHI*7 0050 

* OUTPUTS - IANS=0 ABSVECI 1 . . .5 )=3.0, 4.0, 5.0, 6.0, 7.0 0051 

* 0052 

* 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT IL0=IHI*2 0053 

* OUTPUTS - IANS=C, A8SVEC ( 1 ) = 2.0 0054 

* 0055 
» 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT IHI«2 0056 
» OUTPUTS - IANS=-1 0057 

* 0058 
HTR 0 0059 
BCI 1, ABSVAL 0060 

ABSVAL SXA EXIT,1 0061 

SXD ABSVAL-2,4 0062 

CLA 2,4 A(AULO)) 0063 

STA GET2 0064 

CLA 3,4 A(A(IHI)) 0065 

STA GFT3 0066 

CLA 5,4 A(AIIANS)) 0067 

STA PUT5 0068 

* SET UP CONSTANTS ILO, IHI, LVECT AND CHECK THEM 0069 

* SET IANS FOR ILLEGAL INPUT. 0070 

CLS Kl 0071 

STO I ANS 0072 

GET2 CLA »» A(ILO) 0073 

ARS 18 0074 
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STO 


ILO 




0075 


THI 


LEAVE 




0076 


TZE 


LEAVE 




0077 


GET3 CLA 


• » 


AC IHI) 


0078 


ARS 


18 




0079 


STO 


IHI 




0080 


TMI 


LEAVE 




0081 


TZE 


LEAVE 




0082 


SUB 


ILO 




0083 


ADO 


Kl 




0084 


STO 


LVECT 




0085 


TMI 


LEAVE 




0086 


TZE 


LEAVE 




0087 


STZ 


IANS 




0088 


* SET LOOP UP. 




0089 


CLA 


1»4 


A{ A{ ANYVEC ) ) 


0090 


SUB 


ILO 




0091 


ADD 


K2 




0092 


STA 


CAL 




0093 


CLA 




A( AC ABSVEO) 


0094 


ADO 


Kl 




0095 


STA 


STO 




0096 


LXA 


LVECT, 1 




0097 


* LOOP. 






0098 


CAL CAL 




A{ ANYVEO-ILO + 2 


0099 


STO STO 


»*»1 


AC AB$VEC)+1 


0100 


TIX 


CAL, 1,1 




0101 


* STORE IANS 


AND LEAVE. 




0102 


LEAVE CLA 


IANS 




0103 


ALS 


18 




0104 


PUTS STO 


*» 


AUANS) 


0105 


EXIT AXT 


»*,! 




0106 


TRA 


6,4 




0107 


* CONSTANTS 






0108 


Kl PZE 


1 




0109 


K2 PZE 


2 




0110 


• VARIABLES 






0111 


ILO PZE 


• * 




0112 


IHI PZE 


*• 




0113 


IANS PZE 




0 OR -1 


0114 


LVECT PZE 


• • 


IHI-ILO+1 


0115 


END 






0116 
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* ADANL ( SUBROUTINE ) 9/29/64 LAST CARO IN DECK IS NO. 0335 

* FAP 0001 
•ADANL 0002 

COUNT 300 0003 

L8L ADANL 0004 

ENTRY ADANL (AA,N,M,DAA) 0005 

ENTRY XDANL <XX,N,M,DXX) 0006 

ENTRY ADANX ( I AA,N,M, IDAA ) 0007 

ENTRY XDANX < IXX,N,M, IDXX ) 0008 

* 0009 

* ABSTRACT 0010 

» 0011 

* TITLE - ADANL WITH SECONDARY ENTRY POINTS XDANL, ADANX, XDANX 0012 
» MODIFY AUTO- OR CROSS CORRELATIONS FOR DANIELL SPECTRA 0013 
» 0014 
» ADANL WEIGHTS A ONE-SIDED, FLOATING POINT AUTOCORRELATION 0015 
» FUNCTION, A(L) L=O...N, BY A SIN(Y)/Y TYPE CURVE TO 0016 

* PRODUCE A FLOATING POINT OUTPUT DA(L ) 0017 

* 0018 
» M L*PI 0019 

» DA ( L ) * A{ L) * ( » SINf ) ) 0020 

» L*PI M 0021 

* 0022 

* FOR L » 0,1, ...,N 0023 

* WHERE M AND N ARE INPUT PARAMETERS 0024 

* PI = 3.14159265 0025 
» 0026 

* XDANL WEIGHTS A TWO-SIDED, FLOATING POINT CROSS- 0027 

* CORRELATION FUNCTION, X<L) L= -N...O...N, BY A SINCY)/Y 0028 

* TYPE CURVE TO PRODUCE A FLOATING POINT OUTPUT DX<L> 0029 

* 0030 

* M L*PI 0031 

* DX(L) = X(L) * C * SINI ) ) 0032 

» L*PI M 0033 

* 0034 

* FOR L » -N,-N+1,...,N 0035 

* WHERE M AND N ARE INPUT PARAMETERS 0036 

* PI * 3.14159265 0037 

* 0038 
» ADANX IS IDENTICAL TO ADANL EXCEPT THAT THE INPUTS AND 0039 

* OUTPUTS ARE FIXED POINT VECTORS. 0040 

* 0041 
» XDANX IS IDENTICAL TO XDANL EXCEPT THAT THE INPUTS AND 0042 

* OUTPUTS ARE FIXED POINT VECTORS. 0043 
» 0044 

* LANGUAGE - FAP SUBROUTINE t FORTRAN II COMPATIBLE) 0045 
« EQUIPMENT - 709 OR 7090 IMAIN FRAME ONLY) 0046 

* STORAGE - 183 CELLS 0047 

* SPEED - (APPROX) 709 7090 0048 

* FLOATING PT - 6M + .9N 1.2M ♦ .18N MILLISECS 0049 
» FIXED POINT - 6M ♦ 1.6N 1.2M ♦ .325N MILLISECS 0050 
» AUTHOR - J. CLAER80UT 0051 

* 0052 
» USAGE 0053 

* 0054 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0055 

* AND FORTRAN SYSTEM ROUTINES - SIN 0056 

* 0057 

* FORTRAN USAGE OF ADANL 0058 

* CALL ADANL (AA,N,M,DAA) 0059 

* 0060 
« INPUTS 0061 

* AAU) I = l,2,...,N+l CONTAINS THE AUTOCORRELATION A(0,...,N) 0062 

* WHERE AA(I) = AC(I-l) 0063 

* 0064 

* N MUST BE NON NEGATIVE 0065 

* 0066 
» M IS THE DANIELL WEIGHTING PARAMETER 0067 

* IS A NON-ZERO INTEGER 0068 

* 0069 
» OUTPUTS 0070 

* DAA(I) 1=1.. .N+l CONTAINS THE WEIGHTED AUTOCORRELATION 0071 

* DAI0...N) AS DEFINED IN ABSTRACT 0072 

* WHERE DAA(I) * DA(I-l) 0073 
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* EQUIVALENCE (DAA,AA> IS PERMITTED 0074 
» 0075 

* FORTRAN USAGE OF XDANL 0076 

* CALL XDANL* XX, N,M,DXX) 0077 

* 0078 

* INPUTS 0079 

* XX(I) 1= -N+1,-N+2,...,N+1 CONTAINS THE CROSS-CORRELATION 0080 

* XC-N...N) WHERE XX(I) « XU-1) 0081 
» 0082 

* N SAME AS FOR ADANL 0083 

* M SAME AS FOR ADANL 0084 
» 0085 

* OUTPUTS 0086 
» DXX(I) I* -N+l,-N+2,...,N+i CONTAINS THE WEIGHTED CROSS- 0087 

* CORRELATION DX<-N...N) AS DEFINED IN ABSTRACT 0088 

* WHERE DXX(I) « DX(I-l) 0089 

* EQUIVALENCE <XX,DXX) IS PERMITTED 0090 

* 0091 

* FORTRAN USAGE OF ADANX 0092 

* CALL ADANX( IAA,N,M, IDAA) 0093 

* 0094 
» INPUTS 0095 
» IAAU) SAME MEANING AS FOR ADANL EXCEPT THAT THE AUTOCORRELATION 0096 

* ELEMENTS ARE FIXED POINT QUANTITIES. THE POSITION OF 0097 

* THE BINARY POINT IS IMMATERIAL BUT THE DATA MUST NOT 0098 

* OCCUPY BITS 1 THROUGH 8 . 0099 
» 0100 

* N SAME MEANING AS FOR ADANL 0101 

* M SAME MEANING AS FOR ADANL 0102 

* 0103 
» OUTPUTS 0104 
» IDAA(I) SAME MEANING AS FOR ADANL EXCEPT THE DATA IS FIXED POINT 0105 

* WITH BINARY POINT SAME AS THAI OF IAA. 0106 
» 0107 
» FORTRAN USAGE OF XDANX 0108 

* CALL XDANX( IXX,N,M, IDXX) 0109 

* 0110 

* INPUTS 0111 

* IXX(I) SAME MEANING AS FOR XDANL EXCEPT THAT THE DATA IS FIXED 0112 

* POINT AND MUST NOT OCCUPY BITS 1 THROUGH 8. 0113 

* 0114 

* N SAME MEANING AS FOR XDANL 0115 

* M SAME MEANING AS FOR XDANL 0116 
» 0117 

* OUTPUTS 0118 

* IDXX(I) SAME MEANING AS FOR XDANL EXCEPT IDXX IS FIXED POINT* 0119 

* 0120 

* EXAMPLES 0121 

* 0122 

* I. GENERAL BEHAVIOR ON ELEMENTARY CORRELATIONS 0123 

* INPUTS - AA(1...4)=1. 0,1. 0,1.0,1.0 IAA( 1. . .4)=500, 500,500, 500 0124 

* XX( 1...7)«1.0, 1.0, ...,1.0 IXX< 1...7)=500,500,...,500 0125 

* (NOTE - BIT 9 IS THE MOST SIGNIFICANT BIT OCCUPIED 0126 

* BY IAA OR IXX WITH THESE DEFINITIONS) 0127 

* N = 3 M - 2 0128 

* USAGE - CALL ADANL ( AA,N,M,DAA ) 0129 

* CALL XDANL(XX(4),N,M,DXX(4)> 0130 
» CALL ADANX* IAA, N,M, IDAA) 0131 

* CALL XDANX( IXX<4) ,N,M, IDXXC4) ) 0132 

* OUTPUTS - DAA<L*«*)*LOf 636620, 0.0, -.212207 0133 
» DXX(1...7)=-0. 212207, 0.0, .636620, 1.0, .636620, 0.0, -.212207 0134 

* IDAA<1...4)=500, 318, 0,-106 0135 

* IDXX ( 1... 7 )=-106, 0,318, 500, 318,0,-106 0136 

* 0137 

* 2. EQUATING OUTPUTS WITH INPUTS 0138 

* INPUTS - SAME AS EXAMPLE 1. 0139 
» USAGE - CALL ADANL ( AA, N, M, AA ) 0140 

* CALL XDANL(XX(4),N,M,XX(4)) 0141 
» CALL ADANX (1 AA,N, M, I AA ) 0142 

* CALL XDANX( I XX ( 4 ) ,N, M, IXX ( 4 ) ) 0143 
» OUTPUTS - AA( 1...4)=DAA( 1...4) OF EXAMPLE I. 0144 

* XX(1...7)*0XX< 1...7) OF EXAMPLE 1. 0145 

* IAAU...4) = IDAA( 1...4) OF EXAMPLE 1. 0146 
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» 




IXX(1...7)= 


IDXX(1«.*7) OF EXAMPLE !• 


0147 


* 








0148 


* 








0149 


• PROGRAM FOLLOWS BELOW 




0150 










0151 




H TR 


o 




0152 




8C I 


i _ AflAMI 

1 t H Ly M f H l_ 




0153 


ADANL 


S XA 


SV1 1 1 




0154 




TSX 


MOVA 9 I 


MOVE DATA TO OUTPUT FIELD 


0155 




CLA 


* 




0156 




STO 


AORX 


AORX=0 IF CROSS 


0157 




TRA 


LXL 




01 58 


XDANL 


SXA 


SV 1 , 1 




0159 




TSX 


MOVX , 1 


MOVE DATA 


0160 




STZ 


AORX 


AORX=0 IF CROSS 


0161 




CLA 


» 




0162 


LXL 


STO 


XORL 


XORD=0 IF FIXED 


0163 




SXD 


ADANL-2 t 4 




0164 




TRA 


SFTUP 


SKIP FLOATING 


0165 


ADANX 


SXA 


SV1 , 1 




0166 




TSX 


MOVA , i 


MOVE DATA 


0167 




CLA 


• 


AORX=0 IF CROSS 


0168 




STO 


AORX 




0169 




TRA 


XXL 




0170 


XDANX 


SXA 


SVl , 1 




0171 




TSX 


MO V X , 1 


MOVE DATA 


0172 




STZ 


AORX 


AORX=0 IF CROSS 


01 73 


XXL 


STZ 


XORL 


XORL=0 IF FIXED 


0174 




SXD 


AD ANI —7 - 4 




0175 




TRA 


FLOAT 




0176 


MOVA 


CLA 


M8 




0177 




STA 


TAX 




0178 




TRA 


MAX 




0179 


MOVX 


CLA 


M7 




0180 




S TA 


TAX 




0181 


MAX 


n a 


1.4 




0182 




STA 


Ml 




0183 




S TA 


M3 




0184 




CLA 


4-4 
f «t 




0185 




STA 


MM2 




0186 




STA 


M4 




0187 




CLA* 


2 . 4 




0188 




STD 


M5 




0189 




SXA 


SV2 , 2 




0190 




SXA 


1 lu V UV f A. 




0191 




AXT 






0192 




A XC 


n * i 

U , 1 




0193 


Ml 


CLA 




{ *»=CC ) 


0194 


MM2 


STO 


** v 2 


{ **=DDCC ) 


0195 


TAX 


TRA 




(*#=M3 OR M6) 


0196 


M3 


CLA 


w w ♦ j. 


(**=CC> 


0197 


M4 


STO 




{ »#s:DOCC ) 


0198 




TX I 


*+l * 1 1 — i 




0199 


M6 


TX I 






0200 


M5 


TXL 


Ml,?., ** 


( ) 


0201 


MOVO V 


AXT 


** , 1 


( **= IR1 ) 


0202 




TRA 


1,1 




0203 


M7 


PZE 


M3 




0204 


M8 


PZE 


M6 




0205 


♦FLOAT 


THE 


INPUT DATA 




0206 


FLOAT 


CLA 


4,4 




0207 




STA 


FL1 




0208 




STA 


FL2 




0209 




CLA* 


2,4 




0210 




STD 


FL4 




0211 




STD 


R4 




0212 




AXT 


1,1 




0213 




AXC 


1,2 




0214 


FL1 


CLA 


**, 1 


** = R 


0215 




ORA 


=0233000000000 


0216 




FAD 


=0233000000000 


0217 




STO* 


FL1 




0218 




ZfcT 


AORX 




0219 




TRA 


FL3 


AUTO 


0220 


FL2 


CLA 


**,2 


CROSS **=R 


0221 
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ORA 
FAD 
STO* 
TXI 

FL3 TXI 
FL4 TXL 
♦SET UP FOR WE 
SETUP CLA* 

ARS 

STO 

ARS 

ORA 

FAD 

FDP 

STQ 

CLA 

FDP 

STO 

CLA 

STA 

STA 

STA 

CLA» 

STD 

ARS 

STO 

CLA* 

ADD* 

STD 

CLA 

CAS 

CLA 

STD 

STD 

STZ 

AXC 

AXT 

♦BEGIN WEIGHTI 
NXWVL TXI 
TXI 

MI N TXL 
TRA 

♦ FORM SINtPI* 

CLA 
FAD 
STO 
TSX 
FDP 
STQ 
PXA 
STO 

MORE ORA 
FAD 
STO 
LXA 
CLA 
FDP 
STQ 

R FMP 
STO* 
ZET 
TRA 
LAC 
LDQ 
FMP* 
STO* 

* INCREME 
LP CLA 

ADD 
STO 
CAS 
TRA 
TRA 
TRA 

SMDONE ZET 



=0233000000000 
=0233000000000 
FL2 

*+l,2,-l 
*+l,l,l 
FLl , I » ** 

IGHTING LOOP 
3,4 
17 

TWOM 
1 

=0233000000000 

=0233000000000 

=3. 14159265 

MOVPI 

= 1. 

MOVPI 

PIOVM 

4,4 

R 

Rl 
R? 
2,4 

NO 
18 
N 

3,4 

3,4 

M2 

M2 

ND 

ND 

MIN 

MI N 

ARG 

0,2 

0,1 
NG LOOP 

♦♦1,2,-1 

♦+1,1,1 

*+2,l, ** 

SMDONE 
I/M) 

ARG 

PIOVM 

ARG 

$SIN,4 
PIOVM 
IWT 
0,1 
X2MPI 

=0233000000000 

=0233000000000 

L2MPI 

X2MPI ,4 

IWT 

L2MPI 

TEMP 

** , 4 

*-l 

AORX 

LP 

X2MPI ,4 

TEMP 

R 

R 

NT X2MPI BY 
X2MPI 
TWOM 
X2MPI 
N 

NXWVL 
MORE 
MORE 
XORL 



N IN DECR 



**=MIN{ 2M,N) 

SMOOTHING DONE 



=(M/PI)SIN(PI*I/M) 
PUT I IN AC 
I+MULTIPLE OF 2*M 



I+MULTIPLE OF 2*M 
H-MULTIPLE OF 2*M 
=(M/PI)SIN(PI*I/M) 
I+MULTIPLE OF 2*M 

**=DAT A LOCATION 



AUTO COR 
CROSS COR 



2M 



TEST IF I PLUS SOME 
MULTIPLE OF 2*M IS 
GREATER THAN N 



0222 
0223 
0224 
0225 
0226 
0227 
0228 
0229 
0230 
0231 
0232 
0233 
0234 
0235 
0236 
0237 
0238 
0239 
0240 
0241 
0242 
0243 
0244 
0245 
0246 
0247 
0248 
0249 
0250 
0251 
0252 
0253 
0254 
0255 
0256 
0257 
0258 
0259 
0260 
0261 
0262 
0263 
0264 
0265 
0266 
0267 
0268 
0269 
0270 
0271 
0272 
0273 
0274 
0275 
0276 
0277 
0278 
0279 
0280 
0281 
0282 
0283 
0284 
0285 
0286 
0287 
0288 
0289 
0290 
0291 
0292 
0293 
0294 
0295 
0296 
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TRA 


SV1 DONT FIX DATA 


0297 




AXT 


1,1 FIX DATA 


0298 




AXC 


1,2 


0299 


Rl 


CLA 


*»» 1 


0300 




UFA 


=0233000000000 


0301 




IRS 




0302 




ANA 


=0777777777 


0303 




US 




0304 




STO« 


Rl 


0305 




ZET 


AORX 


0306 




TRA 


R3 AUTO 


0307 


R2 


CLA 


»*,2 


0308 




UFA 


=0233000000000 


0309 




LRS 




0310 




ANA 


=0777777777 


0311 




LLS 




0312 




STO» 


R2 


0313 




TXI 


•♦1,2,-1 


0314 


R3 


TXI 


•♦1,1,1 


0315 


R4 


TXL 


Rl,l,»» **=N 


0316 


SV1 


AXT 




0317 


SV2 


AXT 


**,2 


0318 




LXD 


ADANL-2 f 4 


0319 




TRA 


5,4 


0320 


KOI 


PZE 


,,1 


0321 


AORX 




=0 IF CROSS 


0322 


XORL 




=0 IF FIXED 


0323 


MOVPI 




M/PI 


0324 


PIOVM 




PI/M 


0325 


N 




STORES N IN A DDR 


0326 


X2MPI 




FIXED I+MULTIPLE OF 2*M 


0327 


L2MPI 




FLTG H-MULTIPLE OF 2«M 


0328 


IWT 




=MM/PI )SIN(PI»I/M) 


0329 


TWOM 




2*M IN ADDRESS 


0330 


TEMP 






0331 


M2 




STORE 2M IN DECR 


0332 


ND 




N IN DECR 


0333 


ARG 




ARGUMENT OF SINE 


0334 




END 




0335 
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ADDK # * ADOK 



* 


ADDK 


(SUBROUT 


• 


FAP 




• ADOK 








COUNT 


250 




LBL 


ADDK 




ENTRY 


ADDK 




ENTRY 


SUBK 




ENTRY 


MULK 




ENTRY 


DIVK 




ENTRY 


XADDK 




ENTRY 


XSUBK 




ENTRY 


XMULK 




ENTRY 


XDIVK 




ENTRY 


XDVRK 




ENTRY 


ADDKS 




ENTRY 


SUBKS 




ENTRY 


MULKS 




ENTRY 


DIVKS 




ENTRY 


XADDKS 




ENTRY 


XSUBKS 




ENTRY 


XMULKS 




ENTRY 


XDIVKS 




ENTRY 


XDVRKS 


• 






» 
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9/29/64 LAST CARD IN DECK IS NO. 



( C, XI, 
C C XI, 
( C, XI, 
( C, XI, 
(ICIXl, 
(ICIXl, 
(ICIXl, 
(ICIXl, 
(ICIXl, 
( CI, XI 
( CI, XI 
( CI, XI 
( CI, XI 
(IC1,IX1 
UC1,IX1 
(IC1,IX1 
ClClt 1X1 
(IC1, IXl 



X2,. 

X2, . 

X2,. 

X2, . 
1X2,. 
1X2,. 
1X2,. 
1X2,. 
1X2,. 
, Yl, 
, Yl, 
, Yl, 
, Yl, 
,IY1, 
,IY1, 
,IYl, 
,IY1, 
,IY1, 



., XN) 
., XN) 
., XN) 
XN) 
., IXN) 
•,IXN) 
., IXN) 
.,IXN) 
.,IXN) 
C2, X2, 
C2, X2, 
C2t X2, 
C2, X2, 
IC2,IX2, 
IC2,IX2, 
IC2,IX2, 
IC2,IX2, 
IC2, 1X2, 



Y2,« 
Y2,. 
Y2,« 
Y2,, 
IY2,< 
IY2,, 
IY2,, 
IY2, , 
IY2, . 



CN, 
., CN, 
CN, 
», CN, 
ICN, 
.♦ICN, 
.,ICN, 
ICN, 
ICN, 



XN, YN) 
XN, YN) 
XN, YN) 
XN, YN) 
IXN, I YN ) 
IXN,IYN) 
IXN,IYN) 
IXN, IYN) 
IXNtlYN) 



ABSTRACr- 



* TITLE - ADDK 



WITH SECONDARY ENTRIES SUBK, MULK, DIVK, 

XADDK, XSUBK, XMULK, XDIVK, XDVRK, 

ADDKS, SUBKS, MULKS, DIVKS, 

XADDKS, XSUBKS, XMULKS, XDIVKS, XDVRKS 

MODIFY A SET OF VARIABLES BY A CONSTANT OR BY CONSTANTS 

ADDK AND ITS OTHER ENTRIES ARE VARIABLE LENGTH CALLING 
SEQUENCE SUBROUTINES. FOR THE FIRST NINE ENTRIES THE 
FIRST ARGUMENT IS TAKEN AS A CONSTANT BY WHICH THE 
REMAINING ARGUMENTS ARE TO BE MODIFIED. THE MODIFICATION 
DEPENDS ON THE ENTRY USED AS FOLLOWS 



FLOATING 
ARGUMENTS 

ADDK 
SU8K 
MULK 
DIVK 



FIXED 
ARGUMENTS 

XADDK 
XSUBK 
XMULK 
XOIVK 
XDVRK 



FUNCTION 



ADDS THE CONSTANT 
SUBTRACTS THE CONSTANT 
MULTIPLIES BY THE CONSTANT 
DIVIDES BY THE CONSTANT 
DIVIDES BY THE CONSTANT WITH 

ROUNDING INSTEAD OF TRUNCATION 



THE LAST NINE ENTRIES ASSUME THAT THE NUMBER OF ARGU- 
MENTS IS A MULTIPLE OF THREE, AND THAT WITHIN EACH 
TRIPLET OF THREE ARGUMENTS THE FIRST IS A CONSTANT BY 
WHICH THE SECOND IS TO BE MODIFIED WITH THE RESULT 
STORED IN THE THIRD ARGUMENT. THE NAMES OF THE LAST 
NINE ENTRIES (THE PLURAL ENTRIES) ARE DERIVED FROM THOSE 
OF THE FIRST NINE (THE SINGULAR ENTRIES) BY ADDING 
THE LETTER S. THE MODIFICATION ASSOCIATED WITH A 
PLURAL ENTRY IS THE SAME AS THAT OF ITS SINGULAR 
COUNTERPART. 

THE ORDER OF PROCESSING IS TOWARDS HIGHER ARGUMENTS. 

THE DIVISION ENTRIES SKIP OVER AN ATTEMPT TO DIVIDE BY 
ZERO WITHOUT TURNING ON ANY INDICATORS, BUT NO OTHER 
TESTS FOR POSSIBLE OVERFLOW ARE MADE. 

FOR THE PLURAL ENTRIES, AN ILLEGAL RETURN RESULTS 
FROM AN ARGUMENT COUNT WHICH IS NOT A MULTIPLE OF 3. 

THERE IS NO LIMIT ON THE NUMBER OF ARGUMENTS PERMITTED. 

THERE ARE NO RESTRAINTS ON ARGUMENT EQUIVALENCES. 
HOWEVER NO OUTPUT (THIRD) ARGUMENT MAY BE INVOLVED AS A 
SUBSCRIPT OF, OR IN A DEFINING EXPRESSION FOR, A 
SUBSEQUENT INPUT ARGUMENT, OTHER THAN BY A PURE 
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0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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* EQUIVALENCE. 0075 

* 0076 

* LANGUAGE - FAP SUBROUTINES ( FORTRAN- I I COMPATIBLE) 0077 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0078 

* STORAGE - 114 REGISTERS 0079 

* SPEED - Kl * K2*N MACHINE CYCLES, WHERE N * NO* MODIFICATIONS, 0080 
» AND Kl LIES BETWEEN 33 AND 44 0081 

* K2 LIES BETWEEN 22 AND 59, DEPENDING ON ENTRY 0082 

* AND ON COMPUTER. 0083 
» AUTHOR - S.M. SIMPSON, AUGUST 1963 0084 

* 0085 

* USAGE 0086 

* 0087 

* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0088 
« AND FORTRAN SYSTEM ROUTINES - (NONE) 0089 

* 0090 

* FORTRAN USAGE 0091 

* CALL ADDK ( C, XI, X2,..., XN) 0092 

* CALL SUBK ( C, XI, X2,..., XN) 0093 

* CALL MULK ( C, XI, X2,..., XN ) 0094 

* CALL DIVK ( C, XI, X2,..., XN ) 0095 
» CALL X ADDK ( IC , I X 1 ,T X2 , . . . , I XN ) 0096 

* CALL XSUBK ( I C , I X 1 , I X2 , . . . , I XN ) 0097 

* CALL XMULK ( IC , 1X1, 1X2, . . . , IXN ) 0098 

* CALL XDIVK (IC, 1X1,1X2,..., IXN) 0099 

* CALL XDVRK ( IC , I X 1 , I X2, . . . , I XN ) 0100 

* CALL ADDKS ( CI, XI, Yl, C2, X2, Y2,..., CN, XN, YN) 0101 

* CALL SU8KS ( CI, XI, Yl, C2, X2, Y2,..., CN, XN, YN ) 0102 
« CALL MULKS ( CI, XI, Yl, C2, X2, Y2,..., CN, XN, YN) 0103 

* CALL DIVKS ( CI, XI, Yl, C2, X2, Y2,..., CN, XN, YN) 0104 
» CALL XADDKS ( IC1 , I XI , I Yl , IC2, I X2 , I Y2, . . . , ICN, IXN, I YN ) 0105 

* CALL XSUBKS ( IC1 , 1X1 , IY1 , IC2, 1X2, IY2, . . . , ICN, IXN, I YN ) 0106 

* CALL XMULKS ( I C 1, I XI , I Y I , IC2, I X2, I Y2, . . . , ICN, I XN, I YN ) 0107 

* CALL XDIVKS ( IC1 , I XI , I Yl , IC2, 1X2, I Y2, . .. , ICN, IXN, IYN ) 0108 

* CALL XDVRKS ( IC1 , I XI , I Yl , IC2, 1X2, I Y2, . . . , ICN, IXN, I YN ) 0109 

* 0110 

* IN THE ABOVE EXPRESSIONS, THE LETTER N MAY HAVE ANY VALUE 0111 

* EXCEEDING ZERO. 0112 

* 0113 

* 0114 

* INPUTS 0115 

* 0116 

* C IS A FLTG CONSTANT FOR MODIFYING X1,X2,...XN, FOR THE 0117 
» FLOATING SINGULAR ENTRIES. 0118 
» 0119 

* XI, X2,...,XN ARE THE FLOATING VARIABLES TO BE MODIFIED, FOR 0120 

* ALL FLOATING ENTRIES. 0121 

* THEY ARE ALSO OUTPUTS FOR SINGULAR FLOATING ENTRIES 0122 

* 0123 

* EQUIVALENCES, SOME XJ) IS PERMITTED. THE INITIAL 0124 

* VALUE OF C WILL ALWAYS BE USED FOR MODIFICATION. 0125 

* 0126 

* CI, C2,...,CN ARE THE FLOATING CONSTANTS USED, FOR THE FLOATING 0127 

* PLURAL ENTRIES, TO MODIFY X1,X2,...,XN RESPECTIVELY. 0128 

* 0129 

* EQUIVALENCES, XL) IS PERMITTED FOR ANY J,L PAIR. 0130 
» 0131 
» IC IS THE FIXED PT. ANALOG OF C 0132 

* IXlt 1X2,..., IXN ARE THE FIXED PT. ANALOGS OF XI, , XN 0133 

* ICl, IC2,...,ICN ARE THE FIXED PT. ANALOGS OF C1,...,CN 0134 

* 0135 

* 0136 

* OUTPUTS 0137 

* 0138 

* XI, X2,..., XN ARE OUTPUTS FOR ENTRIES ADDK, SUBK, MULK, DIVK 0139 

* ADDK GIVES XI = XUC,...,XN = XN+C 0140 
» SUBK GIVES XI = X1-C,...,XN XN-C 0141 

* MULK GIVES XI * X1*C,...,XN = XN*C 0142 

* DIVK GIVES XI = X1/C,...,XN = XN/C 0143 
» 0144 

* IX1,...,IXN ARE SIMILAR OUTPUTS FOR XADDK, XSUBK, XMULK, XDIVK, 0145 

* AND XDVRK, WHERE XDIVK TRUNCATES, XDVRK ROUNDS. 0146 

* 0147 

* Yl, Y2,...,YN A Re OUTPUTS FOR ENTRIES ADDKS, SUBKS, MULKS, DIVKS 0148 

* ADDKS GIVES YI=X1+C1, Y2*X2+C2, . . . , YN*XN+CN 0149 
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* SU8KS GIVES Y1=X1-CI, ... , YN=XN-CN 0150 

* MULKS GIVES Yl=Xl*Cl, ... YN=XN*CN 0151 

* DIVKS GIVES YI=X1/C1, ... , YN=XN/CN 0152 

* 0153 

* EQUIVALENCE < C J , XL ) , ( C J , YL ) , ( X J , YL ) IS PERMITTED 0154 

* FOR ALL J,L PAIRS. THE VALUES OF THE OPERANDS 0155 

* USED DURING A MODIFICATION ARE THEIR PRESENT VALUES 0156 

* ANO NOT NECESSARILY THEIR INITIAL VALUES. 0157 

* 0158 
» THE ENTRY DIVK BYPASSES THE COMPUTATION OF EACH YJ 0159 

* OUTPUT FOR WHICH THE CORRESPONDING CJ HAS VALUE 0160 

* ZERO AT THE TIME OF MODIFICATION. 0161 

* 0162 

* THE COMPUTATIONAL ORDER IS Yl, Y2,...,YN. 0163 

* 0164 

* IYI, IY2,...,IYN ARE SIMILAR OUTPUTS FOR XADDKSt XSUBKS, XMULKSt 0165 

* XDIVKSt AND XDVRKS. 0166 

* 0167 

* 1. EXAMPLES OF THE SINGULAR ENTRIES 0168 

* 0169 
» INPUTS - Al f A2, A3 = 1., 2. f 3. Bit B2, B3 * 1., 2., 3. 0170 

* CI, C2, C3 = I., 2., 3. Dlt D2, D3 » 1., 2., 3. 0171 
« IA1,IA2,IA3 * 1, 2* 3 IB1,IB2,IB3 ~ 1» 2, 3 0172 
» IC1,IC2,IC3 = It 2, 3 IDl f ID2,ID3 = 1, 2, 3 0173 

* IEl,ie2,IE3 * It 2, 3 X * 1.0 0174 

* 0175 

* USAGE - CALL ADDK t2., Al f A2, A3) 0176 

* CALL X ADDK (2, IA1,IA2,IA3) 0177 

* CALL SUBK (2., Bl, B2t B3) 0178 

* CALL XSU8K (2, IBl,IB2 f lB3) 0179 

* CALL HULK (2., Clt C2, C3) 0180 
» CALL XMULK (2, IC1,IC2,IC3) 0181 

* CALL DIVK {2., Dl, D2 f D3) 0182 
» CALL XDIVK (2t IDltID2,ID3) 0183 

* CALL XDVRK (2t IE1,IE2,IE3) 0184 

* CALL ADDK (2., X) 0185 

* 0186 

* OUTPUTS - Alt A2, A3 * 3. f 4., 5. IAl, IA2, IA3 » 3, 4, 5 0187 

* Bl, B2, B3 =-1., 0., 1. IB1, IB2 f 183 *-l, 0, I 0188 

* Clt C2, C3 * 2., 4., 6. IC1, IC2, IC3 * 2t 4, 6 0189 

* Dlt D2, D3 = .5, 1., 1.5 IDl, ID2, ID3 » 0, 1, 1 0190 

* IE1, IE2, IE3 = U It 2 X * 3. 0191 

* 6192 

* 2. EXAMPLES OF THE PLURAL ENTRIES 0193 
» 0194 

* INPUTS - SAME AS EXAMPLE 1 0195 

* 0196 

* USAGE - CALL ADDKS( 1., Al, Yi, 4., A2t Y2) 0197 

* CALL SUBKSt 2., Al, Zl, 3., A2, Z2) 0198 

* CALL MULKS ( 3., Al, Ul, 2., A2, U2) 0199 

* CALL DIVKSt 4., Al, VI, 1., A2, V2) 0200 
» CALL XADDKS t 1 ,IAl,IY) 0201 

* CALL XSUBKSC 2 ,IAltIZ) 0202 

* CALL XMULKSl 3 ,IA1,IU) 0203 

* CALL XDIVKSt 2 ,IA3,IV) 0204 

* CALL XDVRKS( 2 «IA3 9 IW) 0205 
» 0206 

* OUTPUTS - Yl t Y2 = 2. ,6. Zl,Z2 * -l.,-l. 0207 

* Ui, U2 = 3. ,4. VltV2 * .25,2.0 0208 

* IY = 2, IZ = -1, IU =3, IV = 1, IW = 2 0209 
» 0210 
« PROGRAM FOLLOWS BELOWS 0211 

* 0212 

* 0213 

* NO TRANSFER VECTOR 0214 

HTR 0 XR4 0215 

BCI 1 1 ADDK 0216 

» PRINCIPAL ENTRY. ADDM C , X 1 , X2, . . . , XN) * ADDK ( ARGSK ) 0217 

ADDK STZ ZIFK 0218 

» SECOND ENTRY. ADDKS (C 1 , XI , Yl ,CN, XN,YN ) = ADDKS ( ARGSKS ) 0219 

ADDKS CLA TRA I 0220 

TRA SETUP 0221 

* THIRD ENTRY. X ADDK ( IC , I X 1, I X2 , . . . , I XN ) * XADDK { XARGSK ) 0222 
XADDK STZ ZIFK 0223 

* FOURTH ENTRY. X ADDKS ( I CI , I XI , I Yl , . . . , ICN, I XN, I YN ) = XADDKSt XARGSKS) 0224 
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XADDKS CLA TRA2 






0225 


TRA SETUP 






0226 


* FIFTH ENTRY. SUBK(ARGSK) 






0227 


SUBK STZ ZIFK 






0228 


* SIXTH ENTRY. SUBKS ( ARGSKS ) 






0229 


SUBKS CLA TRA3 






0230 


TRA SETUP 






0231 


* SEVENTH ENTRY. XSUBK ( XARGSK ) 






0232 


XSUBK STZ ZIFK 






0233 


* EIGHTH ENTRY. X SUBKS ( X ARGSKS ) 






0234 


XSUBKS CLA TRA4 






0235 


TRA SETUP 






0236 


* NINTH ENTRY. MULK ( ARGSK ) 






0237 


MULK STZ ZIFK 






0238 


» TENTH ENTRY. MULKS ( ARGSKS ) 






0239 


MULKS CLA TRA5 






0240 


TRA SETUP 






0241 


* ELEVENTH ENTRY. XMULK ( XARGSK ) 






0242 


XMULK STZ ZIFK 






0243 


* TWELFTH ENTRY. XMULKS ( XARGSKS ) 






0244 


XMULKS CLA TRA6 






0245 


TRA SETUP 






0246 


* THIRTEENTH ENTRY. DIVK(ARGSK) 






0247 


DIVK STZ ZIFK 






0248 


* FOURTEENTH ENTRY. D I VKS ( ARGSKS ) 






0249 


DIVKS CLA TRA7 






0250 


TRA SETUP 






0251 


* FIFTEENTH ENTRY. XDI VK ( XARGSK ) 






0252 


XDIVK STZ ZIFK 






0253 


* SIXTEENTH ENTRY. XD I VKS ( XARGSKS ) 






0254 


XDIVKS CLA XCA 






0255 


TRA SET VRY 






0256 


♦ SEVENTEENTH ENTRY. XDVRK ( XARGSK ) 






0257 


XDVRK STZ ZIFK 






0258 


* EIGHTEENTH ENTRY. XDVRKS ( XARGSKS ) 






0259 


XDVRKS CLA RND 






0260 


SETVRY STO VARY 






0261 


CLA TRA8 






0262 


* SET BRANCH AT MODIFY. THEN CHECK SINGULAR OR 


PLURAL 


0263 


SETUP SXD ADDK-2,4 






0264 


STA MODIFY 






0265 


ZET ZIFK 






0266 


TRA PLURAL 






0267 


* SET UP FOR SINGULAR ENTRIES 






0268 


CLA* 1,4 C OR IC 






0269 


STO CONST 






0270 


CLA SING1 (PZE GETX, 0,1) 






0271 


LDQ SING2 (PZE 1,0,-1) 






0272 


TXI STA, 4,-1 (SET TO PICK UP XI 


FIRST) 


0273 


* SET UP FOR PLURAL ENTRIES 






0274 


PLURAL CLA PLUR1 (PZE GETC, 0,2) 






0275 


LDQ PLUR2 (PZE 3,0,-3) 






0276 


STA STA GETXOC 






0277 


ARS 18 






0278 


STA GETX 






0279 


XCA 






0280 


STA STORE 






0281 


STD BACK 






0282 


* ACQUIRE NEXT POSSIBLE TSX X,0 AND CHECK IF 


IT IS. 




0283 


GETSXZ CAL 1,4 A(TSX XI, 0) SINGULAR, 


A(TSX C1,0) PLURAL 


0284 


ANA MASK KNOCK OUT ADDRESS 






0285 


LAS TSXZ 






0286 


TRA LEAVE 






0287 


GETXOC TRA ** ** = GETX (SINGULAR), = 


GETC (PLURAL) 


0288 


* EXIT AT END OF ARGUMENT STRING. 






0289 


LEAVE SXA ZIFK, 4 RESTORE ZIFK TO NON 


-ZERO 


(PLURAL INDICATION) 


0290 


TRA 1,4 






0291 


* STORE NEXT C OR IC. GET NEXT X OR IX IN AC. 






0292 


* BRANCH TO MODIFY. 






0293 


GETC CLA* 1,4 C1,C2»... 






0294 


STQ CONST 






0295 


GETX CLA* **,4 ** = 1 (SINGULAR), 


' 2 


(PLURAL ) 


0296 


MODIFY TRA ** »* = MOD 1 , M0D2, . . . 


,M0D8 




0297 


* MODIFICATION 1. ADDK OR ADDKS 






0298 


MODI FAD CONST 






0299 
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# STORE RESULT. GO BACK FOR MORE 














0300 


STORE STO» 


«*,4 ** = 1 


(SINGULAR), 




3 


(PLURAL) 


0301 


BACK TXI 


GETSXZ,4,«» *» *-l 


(SINGULAR), 




-3 


(PLURAL) 


0302 


* MODIFICATION 


2. XADDK OR XADDKS 














0303 


M002 ADD 


CONST 














0304 


TRA 


STORE 














0305 


* MODIFICATION 


3. SUBK OR SUBKS 














0306 


MOD3 FSB 


CONST 














0307 


TRA 


STORE 














0308 


* MODIFICATION 


4. XSUBK OR XSUBKS 














0309 


M0D4 SUB 


CONST 














0310 


TRA 


STORE 














0311 


* MODIFICATION 


5. MULK OR MULKS 














0312 


MODS XCA 
















0313 


FMP 


CONST 














0314 


TRA 


STORE 














0315 


* MODIFICATION 


6. XMULK OR XMULKS 














0316 


M0D6 XCA 
















0317 


MPY 


CONST 














0318 


ALS 


17 














0319 


TRA 


STORE 














0320 


* MODIFICATION 


7. DIVK OR DIVKS 














0321 


MOD7 NZT 


CONST BYPASS 


FOR CONST = 


0. 






0322 


TRA 


BACK 














0323 


FDP 


CONST 














0324 


XCA 
















0325 


TRA 


STORE 














0326 


• MODIFICATION 


8. XOIVK, XDIVKS, XDVRK, 


OR 


XDVRKS 






0327 


MOD8 NZT 


CONST 














0328 


TRA 


BACK 














0329 


LRS 


35 














0330 


DVP 


CONST 














0331 


VARY NOP 


= XCA 


OR 


TRA 


ROUND 






0332 


ALS18 ALS 


18 














0333 


TRA 


STORE 














0334 


* ROUNDING INSERT, COMPARES TWICE THE REMAINDER 


AGAINST DENOMINATOR. 


0335 


ROUND SSP 
















0336 


ALS 


1 














0337 


SBM 


CONST 














0338 


CLM 


PREPARE 


FOR 


ROUNDING 


DOWN 


0339 


TMI 


RXCA 














0340 


CLA 


KRND PREPARE 


FOR 


ROUNDING 


UP 




0341 


RXCA XCA 
















0342 


RND 
















0343 


TRA 


ALS18 














0344 


• CONSTANTS, TEMPORARIES 














0345 


TRA1 TRA 


MODI 














0346 


TRA2 TRA 


M0D2 














0347 


TRA3 TRA 


MOD3 














0348 


TRA4 TRA 


M0D4 














0349 


TRA5 TRA 


MOD5 














0350 


TRA6 TRA 


M0D6 














0351 


TRA7 TRA 


M0D7 














0352 


TRA8 TRA 


MOD8 














0353 


TSXZ TSX 


0,0 














0354 


MASK OCT 


777777700000 














0355 


XCA XCA 
















0356 


RND TRA 


ROUND 














0357 


KRND OCT 


200000000000 














0358 


SINGi PZE 


GETX,0,1 














0359 


SING2 PZE 


1,0,32767 














0360 


PLUR1 PZE 


GETC,0,2 














0361 


PLUR2 PZE 


3,0,32765 














0362 


CONST PZE 




IC, 


CL 


OR 


ICL 




L = 1,...,N 


0363 


ZIFK PZE 


1 SET = 0 


FOR 


SINGULAR 






0364 


END 
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* AMPHZ (SUBROUTINE) 10/1/64 LAST CARD IN DECK IS NO. 0250 
» FAP 0001 
♦AMPHZ 0002 

COUNT 280 0003 

LBL AMPHZ 0004 

ENTRY AMPHZ (RE,XIM,LR, AMP, PHZ, R) 0005 

ENTRY REIM ( AMP, PHZ, LR, RE, XIM) 0006 

» 0007 

* ABSTRACT 0008 

* 0009 

* TITLE - AMPHZ , WITH SECONDARY ENTRY POINT REIM 0010 

* AMPLITUDE AND PHASE FROM REAL AND IMAGINARY, OR REVERSE 0011 

* 0012 

* AMPHZ COMPUTES AN AMPLITUDE (AMP) AND PHASE (PHZ) VECTOR 0013 

* FROM THE VECTORS OF THE REAL (RE) AND IMAGINARY (XIM) 0014 

* PARTS* THUS IF 0015 
» 0016 
» Z(J) = RE( J)+I*XIM( J) 0017 

* 0018 
» WHERE I * (-1)**.5 0019 

* THEN 0020 

* 0021 
» AMP(J) = ( RE ( J ) »*2+X IM( J ) **2 )**»5 0022 

* PHZU) = ARCTAN(XIM( J)/RE< J) ) 0023 

* (WITH PROPER QUADRANT CHOICE) 0024 

* * 0.0 IF XIM=RE=0.0 0025 
» 0026 
» PHZ (J) IS COMPUTED SUCH THAT 0027 

* -PI LSTHN PHZ(J) LSTHN« PI 0028 

* THEN, IF DESIRED, A MULTIPLE OF 2P I IS ADDED TO PHZ(J) SO 0029 

* AS TO MINIMIZE THE DIFFERENCE BETWEEN PHZ(J) AND PHZ(J-l). 0030 

* FOR THE LATTER CONDITION, PHZ(l) WILL BE BETWEEN 0031 

* ♦ AND - PI. THIS PROCESS GIVES POINTS ON THE TRUE 0032 

* CONTINUOUS PHASE CURVE PROVIDED THE TRUE PHASE JUMPS ARE 0033 

* LESS THAN MAGNITUDE PI. 0034 
» PI - 3.14159265. 0035 

* 0036 

* REIM REVERSES THE ABOVE PROCESS. IT CALCULATES THE REAL 0037 

* AND IMAGINARY VECTORS FROM THE AMPLITUDE AND PHASE 0038 
» VECTORS. 0039 

* 0040 
» REU) = AMP( J)«C0S(PHZ(J)) 0041 

* XIM(J) = AMP( J)*SIN(PHZ(J)) 0042 

* 0043 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0044 

* EQUIPMENT ~ 709 OR 7090 (MAIN FRAME ONLY) 0045 

* STORAGE - 149 REGISTERS 0046 

* SPEED - ABOUT .00050*LR SECONDS ON THE 7094 MOD 1 FOR BOTH 0047 

* AMPHZ AND REIM, WHERE LR IS LENGTH OF THE VECTORS. 0043 

* AUTHOR - J.F. CLAERBOUT 0049 

* 0050 

* USAGE 0051 

* 0052 
» TRANSFER VECTOR CONTAINS ROUTINES - RND 0053 
» AND FORTRAN SYSTEM ROUTINES - ATAN, SQRT ,COS, S IN 0054 

* 0055 

* FORTRAN USAGE OF AMPHZ 0056 
» CALL AMPHZ ( RE, XIM, LR, AMP, PHZ, R) 0057 
» 0058 

* INPUTS 0059 
» 0060 

* REU) 1 = 1. ..LR IS FLOATING POINT VECTOR OF REAL VALUES. 0061 

* 0062 

* XIM(l) I«1...LR IS FLOATING POINT VECTOR OF IMAGINARY VALUES. 0063 

* 0064 

* LR IS FORTRAN II INTEGER. 0065 

* MUST EXCEED 0 0066 

* 0067 

* R =0 INDICATES PHASE IS BETWEEN ♦ AND - PI. 0068 

* NOT * 0 INDICATES THAT THE PHASE IS TO BE A CONTINUOUS 0069 

* FUNCTION FOR WHICH THE FIRST VALUE IS BETWEEN + AND -PI 0070 

* 0071 

* OUTPUTS 0072 

* 0073 
« AMP(I) 1*1... LR IS FLOATING POINT VECTOR OF THE AMPLITUDES. 0074 
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* EQUIVALENCE WITH RE IS ALLOWED. 
• 

* PHZ(I) I^l.i.LR IS FLOATING POINT VECTOR OF THE PHASES. 

* IF AMP(J)=0. THEN PH2(J)*0. 

* EQUIVALENCE WITH XIM IS ALLOWED. 
» 

* FORTRAN USAGE OF RE I M 

* CALL REIM ( AMP, PHZ, LR, RE, XIM) 
* 

* INPUTS AND OUTPUTS HAVE THE SAME DEFINITIONS AS FOR AMPHZ 

* EXCEPT AMP, PHZ, AND LR ARE INPUTS, 
» RE, AND XIM ARE OUTPUTS. 

• 

» EXAMPLES OF AMPHZ 
* 

* 1. INPUTS - REU...7) = l.,3.,0.,-3.,-l.,-3.,0. LR = 7 R * 0 

* XIMU...7) = 0.,4.,l.,+4., 0.,-4.,-l. 

* OUTPUTS - AMPU...7) = I. , 5. , 1., 5. , 1. , 5. , 1. 

* PHZ11...7) » 0., 0.9273, 1.5708, 2. 2143,3. 1416, -2. 2143, -1.57 



♦ 2. INPUTS - SAME AS EXAMPLE 
» OUTPUTS - AMPU...7) « 1. 
» PHZU...7) = 



1. EXCEPT R=l. 
5.,1.,5., l.,5.,l. 
0., 0.9273, 1.5708, 2. 2143, 3. 1416, 4. 0689, 4. 7124 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 





8SS 


1 




0099 




8CI 


1, AMPHZ 




0100 


AMPHZ 


SXD 


*-2,4 




0101 




SXA 


SVi,i 




0102 




CLA* 


6,4 




0103 




STO 


TSTCN 




0104 




CLA* 


3,4 


GET 


0105 




STD 


A10 


N 


0106 




CLA 


i»4 


RE 


0107 




ADD 


= 1 




0108 




STA 


A2 




0109 




CLA 


2,4 


IM 


0110 




ADD 


= 1 




0111 




STA 


Al 




0112 




CLA 


4,4 


AMP 


0113 




ADD 


= 1 




0114 




STA 


A4 




0115 




CLA 


5,4 


PHZ 


0116 




ADD 


= 1 




0117 




STA 


A5 


THIS PHZ 


0118 




ADD 


= 1 




0119 




STA 


A6 


PREVIOUS PHZ 


0120 




STO 


FIRST 


STORE SOME NON-ZERO QUANTITY 


0121 




AXT 


1,1 


SET FOR LOOP OF LENGTH N 


0122 


PIPI 


ZET» 


A2 


IF REAL PART IS ZERO 


0123 




TRA 


Al 


ISN*T 


0124 




CLA 


*1. 57079633 


SET EQUAL +PI/2 OR -PI/2 


0125 




TRA 


A3 




0126 


Al 


CLA 


**,1 


I MAG 


0127 


A2 


FDP 


**, 1 


REAL 


0128 




XCA 






0129 




SSP 






0130 




TSX 


$ATAN,4 




0131 




THE FOUR QUADRANT AMBIGUITY IS ELEGANTLY RESOLVED IN THE NEXT 5 


0132 




INSTRUCTIONS 




0133 




LDQ» 


A2 


RIGHT OR LEFT HALF PLANE 


0134 




TQP 


A3 


RIGHT 


0135 




FSB 


=3.14159265 


LEFT 


0136 


A3 


LDQ* 


Al 




0137 




LLS 


0 


UPPER OR LOWER HALF PLANE 


0138 




STO 


PHZ 




0139 




LDQ* 


Al 


COMPUTE AMPLITUDE 


0140 




FMP* 


Al 




0141 




STO 


AMP 




0142 




LDQ* 


A2 




0143 




FMP* 


A2 




0144 




FAD 


AMP 




0145 




TSX 


$SQRT,4 




0146 


A4 


STO 


**,i 


STO AMPL 


0147 




TNZ 


♦♦2 


IF AMP=0. 


0148 




STZ 


PHZ 


SET PHZ=0. 


0149 
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ZET 


TSTCN REPRESENT PHASE PI TO -PI 


0150 




TRA 


CONT OR CONTINUOUSLY 


0151 


A45 


STZ 


FIRST 


0152 




CLA 


PHZ STORE PHASE 


0153 


A5 


STO 




0154 


A9 


TXI 


♦♦1,1,1 REPEAT LOOP 


0155 


AlO 


TXL 


PIPI,i,»» *»-N 


0156 


All 


LXD 


AMPHZ-2,4 


0157 


SV1 


AXT 


»*,1 


0158 




TRA 


7,4 


0159 


CONT 


ZET 


FIRST 


0160 




TRA 


A45 WE DONT HAVE A FIRST VALUE YET 


0161 


* 


GET M= 


IPREV PHASE)/<2 » PI) ROUNDED TO INTEGER 


0162 


A6 


CLA 


**,1 GET PREV PHASE 


0163 




FDP 


=6.2831853 


0164 




XCA 




0165 




TSX 


$RND,4 


0166 




XCA 




0167 




FMP 


=6.2831853 2*PI»M = C<AC) 


0168 




STO 


TWOPIM 


0169 


♦ 


FORM 


SS=ABSF(PHZ+2.*PI»M-PHZPRV> 


0170 


* 


FORM 


SM=ABSF<PHZ*2.*PI*M-PHZPRV-2.*PI ) 


0171 


* 


FORM 


SP=ABSF<PHZ+2.*PI*M-PHZPRV4-2.*Pn 


0172 




FAD 


PHZ 


0173 




FSB» 


A6 


0174 




STO 


SS SS STILL NEEDS ABS VALUE 


0175 




FSB 


=6.2831853 


0176 




SSP 




0177 




STO 


SM GOT SM 


0178 




CLA 


SS 


0179 




FAD 


=6.2831853 


0180 




SSP 




0181 




STO 


SP GOT SP 


0182 




CAL 


SS 


0183 




STO 


SS GOT SS 


0184 


* 


FORM 


PHZTRIAL=PHZ+2.*PI»M 


0185 




CLA 


PHZ 


0186 




FAD 


TWOPIM 


0187 




STO 


PHZ 


0188 


* 


WHIC IS 


SMALLER, SS,SP, OR SM 


0189 


* 


IF SS, 


THEN PHASE = PHZTRIAL 


0190 


* 


IF SM, 


THEN PHASE = PHZTRIAL - 2 PI 


0191 


• 


IF SP, 


THEN PHASE = PHZTRIAL + 2 PI 


0192 




CLA 


SS 


0193 




SUB 


SM 


0194 




TPL 


A7 TRA IF SS GREATER SM 


0195 




CLA 


SS SS SMALLER SM 


0196 




SUB 


SP 


0197 




TMI 


A5-I SS SMALLEST, STORE PHASE 


0198 


A65 


CLA 


PHZ SP SMALLEST 


0199 




FAD 


=6.2831853 


0200 




TRA 


A5 STORE CORRECT PHASE 


0201 


A7 


CLA 


SM SM SMALLER SS 


0202 




SUB 


SP 


0203 




TPL 


A65 SP SMALLEST 


0204 




CLA 


PHZ SM SMALLEST 


0205 




FSB 


=6.2831853 


0206 




TRA 


A5 STORE CORRECT PHASE 


0207 


TSTCN 


PZE 




0208 


TWOPIM 


PZE 




0209 


SS 


PZE 




0210 


SM 


PZE 




0211 


SP 


PZE 




0212 


FIRST 


PZE 




0213 


AMP 


PZE 




0214 


PHZ 


PZE 




0215 


REIM 


SXD 


AMPHZ-2,4 


0216 




SXA 


R5,l 


0217 




CLA 


1,4 AMP 


0218 




ADD 


= 1 


0219 




STA 


R2 


0220 




CLA 


2,4 PHASE 


0221 




ADD 


= 1 


0222 




STA 


Rl 


0223 




CLA 


4,4 RE 


0224 



*»»••*»•»»*•••»»••»*•••» PROGRAM LISTINGS »*»*»»»»*•**»*»»»»*»« 

* AMPHZ * • AMPHZ 

**••••»•*»••»*•*••»»**•• *»»**»»*»»»»*»»*•»**« 

(PAGE 4) i PAGE 





A 00 


= 1 




0225 




STA 


R3 




0226 




CLA 


5,4 




0227 




ADO 


= 1 




0228 




STA 


R4 


IM 


0229 




CLA* 


3,4 


GET N 


0230 




POX 


1 1 


STORE IN IR1 


0231 


R2 


CLA 


»*,1 




0232 




STO 


AMP 




0233 


Rl 


CLA 






0234 




STO 


PHZ 




0235 




TSX 


$C0S,4 




0236 




XCA 






0237 




EMP 


AMP 




0238 


R3 


STO 






0239 




CLA 


PHZ 




0240 




TSX 


$SIN,4 




0241 




XCA 






0242 




EMP 


AMP 




0243 


R4 


STO 


**, I 




0244 




TIX 


R2,l,l 




0245 


R5 


AXT 


**tl 




0246 




LXD 


AMPHZ-2,4 




0247 




TRA 


6,4 




0248 


ORE 


OCT 


233000000000 




0249 




END 






0250 
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» ARBCOL (SUBROUTINE) 9/9/64 LAST CARD IN DECK IS NO. 0270 

* FAP 0001 
•ARBCOL 0002 

COUNT 200 0003 

LBL ARBCOL 0004 

ENTRY ARBCOL ( EOF IJ , LI , L J, IDI MEN, F JCOL ,COL ) 0005 

« 0006 

* 0007 

* ABSTRACT 0008 

* 0009 

* TITLE - ARBCOL 0010 

* FIND A MATRIX COLUMN WITH ARBITRARY INDEX BY INTERPOLATION 0011 
» 0012 

* ARBCOL IS GIVEN A MATRIX AND A FLOATING POINT NUMBER 0013 
» (GENERALLY NOT A WHOLE NUMBER) REPRESENTING A DESIRED 0014 

* COLUMN NUMBER IN THE MATRIX. THE FOUR COLUMNS WHICH 0015 
» ARE CLOSEST IN NUMBER TO THE DESIRED COLUMN NUMBER ARE 0016 

* SUBJECTED TO CUBIC INTERPOLATION TO YIELD THE 0017 

* INTERPOLATED COLUMN. 0018 

* 0019 

* ARBCOL REDUCES THE DEGREE OF INTERPOLATION IN THE 0020 

* CASES OF MATRICES WITH ONLY 3* 2, OR 1 COLUMNS. 0021 

* 0022 
« THE PROCEDURE USED IS TO FIND THE PROPER INTERPOLATION 0023 
» OPERATOR FOR THE GIVEN COLUMN NUMBER AND THEN APPLY IT 0024 
» IN A HIGH SPEED LOOP ON THE ROW INDEX. 0025 

* 0026 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN-I I COMPATIBLE) 0027 
» EQUIPMENT - 709 OR 7090 {MAIN FRAME ONLY) 0028 

* STORAGE - 129 REGISTERS 0029 
» SPEED - TAKES ABOUT 530 ♦ 90*N MACHINES CYCLES ON THE 7090, 0030 
» WHERE N = NO. ROWS IN THE MATRIX. 0031 

* AUTHOR - S.M. SIMPSON, MARCH 1964 0032 

* 0033 

* 0034 

* USAGE 0035 

* 0036 

* TRANSFER VECTOR CONTAINS ROUTINES - INTOPR 0037 

* AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0038 

* 0039 

* FORTRAN USAGE 0040 

* CALL ARBCOL(FOFIJ,LI,LJ,IDIMEN, FJCOL,COL) 0041 

* 0042 
» INPUTS 0043 
» 0044 

* FOFIJU,J) 1=1. ..LI, J=1...LJ IS A MATRIX OF FLOATING POINT 0045 
» ELEMENTS. 0046 

* 0047 
» LI MUST EXCEED ZERO 0048 

* 0049 

* LJ MUST EXCEED ZERO 0050 

* 0051 

* IDI MEN IS THE DIMENSION, IN THE CALLING PROGRAM, OF THE 0052 

* INDEX I OF FOFIJ(I,J) 0053 

* MUST BE GRTHN= LI 0054 

* 0055 
» FJCOL IS THE FLOATING POINT COLUMN NUMBER FOR WHICH AN 0056 
» INTERPOLATED COLUMN IS DESIRED 0057 
» MUST BE GRTHN= 1.0, AND LSTHN FL0ATF1L J+l ) 0058 

* 0059 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUTS IF LI, LJ, IDIMEN, OR 0060 

* FJCOL IS ILLEGAL 0061 

* 0062 

* COL(I) 1=1... LI IS THE INTERPOLATED COLUMN 0063 

* 0064 

* 0065 

* EXAMPLES 0066 
« 0067 

* 1. THIS EXAMPLE INTERPOLATES ALL HALF-INDEX AND FULL-INDEX COLUMNS 0068 

* IN A 1-COLUMN, A 2-COLUMN, . . . , AND A 5-COLUMN MATRIX. IT ALSO 0069 

* SHOWS THAT NO INTERPOLATION RESULTS FOR ILLEGAL FJCOL VALUES. 0070 

* 0071 
» INPUTS - FOFIJ( 1,2, 3, ,1,2, 3, 4,5) » 0072 
» 0.,0.,0.,, 0.,1.,2.,, 0.,2.,4.,, 0.,3.,6.,, 0.,4.,8. 0073 
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• 










0074 


* 










0075 


« 


USAGE 


DIMENSION FOFIJ( 10,5), COL( 3,9,5) 




0076 


• 






DO 10 LJ=1,5 




0077 


* 






DO 10 J = l,9 




0078 


• 






FJCOL * ( FLOAT F( J+i ) )/2«0 




0079 


» 






10 CALL ARBC0L(F0FIJ,LI,LJ,IDIM£N,FJC0L,C0L(1,J, 


LJ) ) 


0080 


• 










0081 


• 


OUTPUTS - 


C0L(1...3,1,LJ) * 0., 0., 0. FOR LJ*1...5 




0082 


« 






C0L(1...3,2,1) * O.t 0., 0, 




0083 


* 






COL(1...3,2,LJ) * 0,, .5, 1. FOR LJ=2...5 




0084 


* 






C0L(i...3,3,LJ) * 0., l. f 2. FOR LJ=2...5 




0085 


• 






COL ( 1. • *3 ,4, LJ ) * 0.,l.5, 3. FOR LJ*2...5 




0086 


* 






C0L(1...3,5,LJ) * 0., 2., 4. FOR LJ*3...5 




0087 


• 






C0L(1...3,6,LJ) - 0.,2,5, 5. FOR LJ=3.,.5 




0088 


* 






COL( 1...3, 7,LJ) = 0., 3., 6. FOR LJ=4,5 




0089 


* 






C0L(1...3,8,LJ) * 0.,3.5, 7. FOR LJ,4,5 




0090 


* 






C0L(1„..3,9,5) » 0., 4., 8. 




0091 


• 






C0L(l..«3t J»LJ) = -99,, -99. ,-99. WHENEVER J GRTHN 


2*LJ 


0092 


• 










0093 


• 










0094 


* 


PROGRAM FOLLOWS BELOW 




0095 


• 










0096 


» 


TRANSFER VECTOR CONTAINS INTOPR ONLY 




0097 






HTR 


0 XR1 




0098 






HTR 


0 XR4 




0099 






BCI 


1, ARBCOL 




0100 


* 










0101 


♦ 


ONLY 


ENTRY. 


ARBCOL (FOFIJ,LI»LJ»lDIMEN,FJCOL»COL) 




0102 


• 










0103 


ARBCOL 


SXD 


ARBCOL-2,4 




0104 






SXD 


ARBCOL-3, 1 




0105 


* 










0106 


» 


CHECK Lit LJ 


AND IDIMEN 




0107 


« 










0108 






CLA* 


2,4 LI 




0109 






TMI 


LEAVE 




OHO 






TZE 


LEAVE 




Olll 






PDX 


0,1 (FOR LOOP AT STZ) 




0112 






CLA» 


3,4 LJ 




0113 






TMI 


LEAVE 




0114 






TZE 


LEAVE 




0115 






CLA* 


4,4 IDIMEN 




0116 






SUB* 


2,4 MINUS LI 




0117 






TMI 


LEAVE 




0118 






ADD* 


2,4 




0119 






ARS 


13 




0120 






STO 


IDIM 




0121 


* 










0122 


• 


FIND 


JCOL * 


FJCOL ROUNDED DOWN EXCEPT IN THE CASE THAT 




0123 


* 






FJCOL * FLOAT F ( LJ ) AND LJ EXCEEDS 1 




0124 


* 


IN WHICH 


CASE SET JCOL = LJ-l 




0125 


* 










0126 






CLA* 


5,4 FJCOL 




0127 






UFA 


K233 




0128 






LRS 


0 




0129 






ANA 


KDECR 




0130 






LLS 


0 




0131 






ALS 


18 




0132 






CAS* 


3,4 




0133 






TRA 


LEAVE EXCEEDS LJ 




0134 






TRA 


LJCK EQUALS LJ 




0135 






TMI 


LEAVE 




0136 






TZE 


LEAVE 




0137 






TRA 


JCOK 




0138 


LJCK 


SUB 


KD1 




0139 






TNZ 


JCOK 




0140 






ADD 


KDl (EQUALS LJ EQUALS i) 




0141 


* 










0142 


* 


THEN 


FORM X 


* FJCOL - FLOATF ( JCOL ) 




0143 


• 










0144 


JCOK 


STO 


JCOL 




0145 






LRS 


18 




0146 






ORA 


K233 




0147 






FAD 


K233 




0148 
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CHS 0149 

FAD* 5,4 0150 

STO X 0151 

* 0152 

* NOW SOME ADDRESS SETUPS 0153 
» 0154 

CLA JCOL 0155 

SUB KD2 0156 

XCA 0157 

MPY IDIM 0158 

LLS 17 0159 

CHS 0160 

ADD Kl 0161 

ADD 1,4 A(FOFIJ)-( JCOL-2 ) * IDIMEN+1 0162 

STA LDQ1 0163 

SUB IDIM 0164 

STA LDQ2 0165 

SUB IDIM 0166 

STA LDQ3 0167 

SUB IDIM 0168 

STA LDQ4 0169 

CLA 6,4 A(COL> 0170 

ADD Kl 0171 

STA STORE 0172 

* 0173 

* SET UP AS THOUGH NDATA=4 THEN TEST JCOL 0174 
» 0175 

CLA FMP1 0176 

STA TSXOP 0177 

CLS K1L 0178 

STO XLO 0179 

CLA KD4 0180 

STO NDATA 0181 

CLA JCOL 0182 

SUB KDl 0183 

TZE JC0L1 0184 

* 0185 
» SETTINGS FOR JCOL EXCEEDING 1 ARE ALL MADE UNLESS JC0L*1*LJ 0186 

* 0187 
ADD KD2 JCOL+i 0188 
SUB* 3,4 COMPARE WITH LJ 0189 
TZE NDATA3 SAME, CHANGE NDATA TO 3 0190 
TRA GETOP SMALLER, ALL SETTINGS OK 0191 

» 0192 

* SETTINGS IF JCOL^l 0193 

* 0194 
JC0L1 CLA FMP2 A(FMP2) * 0PER2 0195 

STA TSXOP 0196 

STZ XLO XLO=0.0 0197 

CLA* 3,4 TRIAL SET NDATA 0198 

STO NDATA =LJ (OK IF LJ=1 OR 2) 0199 

SUB KD3 THEN TEST 0200 

TMI STZOP (NEGATIVE IF LJ=1 OR 2) 0201 

* 0202 

* CHANGE NDATA TO 3 FOR INTERPOLATING NEAR RIGHTMOST COLUMN. 0203 

* 0204 
NDATA3 CLA KD3 0205 

STO NDATA 0206 

* 0207 

* CLEAR 0PER1,3,4, IF NDATA IS NOT 4 0208 

* 0209 
STZOP STZ 0PER1 0210 

STZ 0PER3 0211 

STZ 0PER4 0212 

* 0213 

* GO GET THE OPERATOR 0214 

* 0215 
GETOP TSX $INT0PR,4 0216 

TSX NDATA, 0 12 3 3 4 0217 

TSX XL0,0 0.0 0.0 0.0 -1.0 -1.0 0218 

TSX KlL,0 DELX 0219 

TSX X,0 0220 

TSXOP TSX **,0 ** * 0PER2 0PER2 0PER2 0PER1 0PER1 0221 

LXD ARBCOL-2,4 0222 

» 0223 
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LOOP 


FORMING INTERPOLATES, 


XRi=Ll,LI-l, 1 


0224 










0225 


ST2 


STZ 


TEMP 




0226 


LDQi 


LDQ 


»*, 1 


** = A(FOFIJ)-( JC0L-2)*IDIMEN*1 


0227 


FMP1 


FMP 


OPER1 




0228 




FAD 


TEMP 




0229 




STO 


TEMP 




0230 


LDQ2 


LOO 




** = DITTO LDQI MINUS IDIMEN 


0231 


FMP2 


FMP 


OPER2 




0232 




FAD 


TEMP 




0233 




STO 


TFMP 




0234 


LDQ3 


LDQ 


•♦,1 


** = DITTO LDQ2 MINUS IDIMEN 


0235 




FMP 


OPER3 




0236 




FAD 


TEMP 




0237 




STO 


TEMP 




0238 


LDQ4 


LDQ 


»*,l 


** * DITTO LDQ3 MINUS IDIMEN 


0239 




FMP 


0PER4 




0240 




FAD 


TEMP 




0241 


STORE 


STO 


**,i 


** = A(C0L>+1 


0242 




TIX 


STZ ,1,1 




0243 
0244 


EXIT 








0245 
0246 


LEAVE 


LXD 


ARBCOL-3,1 




0247 




TRA 


7,4 




0248 
0249 


CONSTANTS, 


VARIABLES 




0250 










0251 


Kl 


PZE 


1 




0252 


KD1 


PZE 


0,0,1 




0253 


KD2 


PZE 


0,0,2 




0254 


K03 


PZE 


0,0,3 




0255 


KD4 


PZE 


0,0,4 




0256 


K233 


OCT 


233000000000 




0257 


KDECR 


OCT 


000000377777 




0258 


K1L 


DEC 


1.0 




0259 


IDIM 


PZE 


** 




0260 


JCOL 


PZE 


0,0,** 




0261 


NDATA 


PZE 


0,0,** 


1, 2, 3, OR 4 


0262 


XLO 


PZE 




NORMALLY = -1.0 (MAY BE 0,0) 


0263 


X 


PZE 


• * y «*, •* 


EQUALS FJCOL-FLOATF< JCOL) 


0264 


TEMP 


PZE 


*»,»•,»• 




0265 


0PER4 


PZE 


**,#*,»# 


MULTIPLIES COLUMN NO. JCOL+2 


0266 


0PER3 


PZE 


»«,»»,*« 


MULTIPLIES COLUMN NO. JCOL+1 


0267 


0PER2 


PZE 


• * v •* v ft* 


MULTIPLIES COLUMN NO. JCOL 


0268 


OPER1 


PZE 
END 


• « 9 »* y *» 


MULTIPLIES COLUMN NO. JCOL-1 


0269 
0270 
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* ARCTAN (FUNCTION) 9/4/64 LAST CARD IN DECK IS NO. 0091 



» 


FAP 






0001 


♦ARCTAN 






0002 




COUNT 


30 




0003 




LBL 


ARCTAN 




0004 




ENTRY 


ARCTAN F(X t Y) 




0005 


* 








0006 


* 








0007 


• 




ABSTRACT 




0008 


• 








0009 


* 


TITLE - ARCTAN 




0010 


« 


ARCTANGENT FUNCTION 




0011 


» 








0012 


* 




ARCTAN FINDS THE ANGLE IN RADIANS ASSOCIATED WITH AN 


0013 


• 




X AND Y COORDINATE SUCH THAT 




0014 


* 








0015 


* 




-3.14159265 LSTHN ANGLE LSTHN= 


3.14159265 


0016 


* 








0017 


* 








0018 


» 


LANGUAGE 


- FAP FUNCTION (FORTRAN II COMPATIBLE) 




0019 


• 


EQUIPMENT 


- 709 OR 7090 (MAIN FRAME ONLY) 




0020 


♦ 


STORAGE 


- 29 REGISTERS 




0021 


* 


SPEED 


- ABOUT 250 MACHINE CYCLES ON 7090. 




0022 


* 


AUTHOR 


- R.A. WIGGINS MARCH 1964 




0023 


» 








0024 


* 








0025 


• 




USAGE 




0026 


• 








0027 


* 


TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 




0028 


• 


AND 


FORTRAN SYSTEM ROUTINES - ATAN 




0029 


» 








0030 


* 


FORTRAN USAGE 




0031 


* 


ANGLE 


= ARCT ANF ( X t Y ) 




0032 


* 








0033 


• 








0034 


* 


INPUTS 






0035 


* 








0036 


• 


X 


IS THE ABSCISSA OF THE POINT 




0037 


* 








0038 


* 


Y 


IS THE ORDINATE OF THE POINT 




0039 


* 








0040 


♦ 








0041 


* 


OUTPUTS 






0042 


* 








0043 


* 


ANGLE 


IS THE ANGLE IN RADIANS FROM THE POSITIVE X-AXIS TO THE 


0044 


• 




POINT, = ARCTANGENT OF Y/X . 




0045 


* 








0046 


» 








0047 


• 


EXAMPLES 






0048 


• 








0049 


• 


1. USAGE 


ANGLE1 = ARCT ANF ( -2., 0.) 




0050 


• 




ANGLE2 = ARCTANF ( -2., 1.) 




0051 


* 




ANGLE3 * ARCTANF ( 0., 1.) 




0052 


• 




ANGLE4 = ARCTANF ( 2., 1.) 




0053 


* 




ANGLE5 = ARCTANF ( 2., 0.) 




0054 


* 




ANGLE6 = ARCTANF ( 2., -1.) 




0055 


• 




ANGLE7 * ARCTANF ( 0., -1. ) 




0056 


• 




ANGLE8 = ARCTANF ( -2., -1.) 




0057 


* 


OUTPUTS 


- ANGLE1 = 3,1416 ANGLE2 = 2.6779 


ANGLE 3 = 1.5708 


0058 


* 




ANGLE4 = 0.4636 ANGLE5 = 0. 


ANGLE6 =-0.4636 


0059 


* 




ANGLE7 =-1.5708 ANGLE8 =-2.6779 




0060 


• 








0061 


* 








0062 


» 


PROGRAM FOLLOWS BELOW 




0063 


* 








0064 


XR4 HPR 


0 




0065 




BCI 


1 t ARCTAN 




0066 


ARCTAN SXD 


XR4,4 




0067 




STO 


XI 




0068 




TZE 


A 




0069 




TMI 


Al 




0070 




STZ 


CRRCT 




0071 




TRA 


A3 




0072 


A CLA 


=1.57079632 




0073 




TRA 


Al+1 




0074 
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Al 


CLA 


=3.14159265 




TOP 


A2 




SSM 




A2 


STO 


CRRCT 




PXD 


»o 




NZT 


XI 




TRA 


ADD 


A3 


XCA 






FDP 


XI 




XCA 






TSX 


$ATAN f 4 


AOD 


FAD 


CRRCT 




LXD 


XR4,4 




TRA 


1»4 


CRRCT 


PZE 


0 


XI 


PZE 
END 


0 



» ARCTAN 



i PAGE 2) 

0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
Q089 
0090 
0091 



*•••••*»••*«*»»***»*•»*• PROGRAM LISTINGS 

» ARG * 

#*»#♦»♦*#♦#*♦****#*##*»* 

REFER TO 

LOCATE 



•**##»••»**•••*»•*»•*»•* 

* ARG f 
#«#•*♦»##»*###»**#»«»«*♦ 

REFER TO 
LOCATE 
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ASPECT * * ASPECT • 
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» ASPECT (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0535 

« FAP 0001 

•ASPECT 0002 

COUNT 560 0003 

LBL ASPECT 0004 

ENTRY ASPECT ( ACOR, N, COST AB,M, JMIN, JMAX, TYPE , SPEC T, SPACE t 0005 

* I SCALE* ERR ) 0006 

* 0007 

* ABSTRACT 0008 

* 0009 

* TITLE - ASPECT 0010 

* FAST COSINE TRANSFORMS OF ONE-SIDED AUTOCORRELATIONS 0011 

* 0012 
» ASPECT PRODUCES A HI-SPEED POWER- OR ENERGY-DENSITY 0013 

* SPECTRUM (OR PORTION THEREOF) FROM AN N-LAG AUTOCORREL- 0014 

* ATI ON FUNCTION, AC(I) I=0,i,...,N, ACCORDING TO 0015 

* 0016 
» N 0017 

* SPU) = AC(O) + 2»SUM { AC( I )*COS< I*J*(PI/M)) ) 0018 
» 1=1 0019 

* 0020 

* FOR J = JMIN, JMIN+1,..., JMAX 0021 

* WHERE 0022 

* PI = 3.14159265 0023 

* N,M,JMIN AND JMAX ARE INPUT PARAMETERS 0024 

* COS(J*(PI/M)) J=0,1,...,M IS AN INPUT TABLE 0025 
» 0 LSTHN* JMIN LSTHN JMAX LSTHN* M 0026 
» 0027 

* SPEED IS ATTAINED BY 0028 

* 1. (FOR M LSTHN-N ) 0029 

* - COLLAPSING ACU) INTO THE RANGE 0 TO 2M 0030 

* - SPLITTING THE COLLAPSED 0031 

* CORRELATION INTO ODD AND EVEN PARTS AND 0032 

* SUBPARTS (ONLY 2 OF THESE 4 ARE USED) 0033 

* 2. USING THE HIGH-SPEED LOOPING LOGIC OF SUBROUTINE 0034 

* COSP TO PERFORM THE TRANSFORMS OF THE SHORTENED 0035 

* PARTS (LENGTH * M/2) 0036 
» 0037 

* THE AUTOCORRELATION MAY BE FLOATING POINT OR FIXED 0038 
» (COMPUTATIONS SLIGHTLY FASTER FOR FIXED POINT) 0039 

* 0040 

* 2»M+1 TEMPORARY REGISTERS ARE NEEDED UNLESS USER IS 0041 

* WILLING TO SACRIFICE THE AUTOCORRELATION FOR THIS PURPOSE 0042 

* (TEMPORARIES NOT REQUIRED FOR M GRTHN N) 0043 

* 0044 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0045 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0046 
» STORAGE - 278 REGISTERS 0047 

* SPEED - FIXED PT, M LSTHN 3 * N - 1 7*M* ( JMAX- JM IN + 1 ) MACH. CYCLES 0048 
» FLTG. PT, M LSTHN= N - 19*M* ( JMAX-JM IN+1 ) MACH. CYCLES 0049 

* (FOR M GRTHN N SUBSTITUTE 2N FOR M IN ABOVE FORMULAS) 0050 

* AUTHOR - S.M. SIMPSON JR, OCT, 1961 0051 

* 0052 

* USAGE 0053 

* 0054 

* TRANSFER VECTOR CONTAINS ROUTINES - COLAPS, COSP, DUBLX, DUBLL, 0055 

* SPLIT, RVPRTS 0056 

* AND FORTRAN SYSTEM ROUTINES - NONE 0057 

* 0058 
» FORTRAN USAGE 0059 

* CALL ASPECT (ACOR, N, COST AB,M, JMIN, JMAX, TYPE, SPECT, SPACE, I SCALE, ERR) 0060 

* 0061 

* INPUTS 0062 

* 0063 
» ACOR(I) 1*1.. .N+l CONTAINS ACU) J=0,1,...,N 0064 
» ACOR IS FIXED OR FLTG AS SPECIFIED BY TYPE 0065 
« 0066 

* N MUST EXCEED ZERO 0067 

* 0068 

* COSTAB(I) 1=1.. .M+l CONTAINS C0S(J*PI/M) J=0,l,...,M 0069 

* COSTAB IS FIXED OR FLTG AS SPECIFIED BY TYPE 0070 

* IF FIXED PT IT IS ASSUMED THAT THE BINARY POINT IS 0071 
» BETWEEN THE SIGN BIT AND BIT I SO THAT VALUES =+1. AND 0072 

* -1. SHOULD BE ENTERED AS OCT 377777777777 AND 0073 

* OCT 777777777777 RESPECTIVELY. THE BINARY POINT OF 0074 
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* ACOR IS IMMATERIAL BUT ACCURACY IS GREATER FOR FEWER 0075 

* LEADING ZEROES. 0076 

* 0077 

* M MUST EXCEED ZERO 0078 
» 0079 

* JMIN DEFINES LOWEST MULTIPLE OF FUNDAMENTAL DESIRED 0080 
» MUST BE GRTHN* 0 AND LSTHN JMAX 0081 

* 0082 

* JMAX DEFINES HIGHEST MULTIPLE OF FUNDAMENTAL DESIRED 0083 
» MUST BE GRTHN JMIN AND LSTHN* M 0084 

* 0085 
» TYPE * 0.0 SIGNIFIES ACOR AND COSTAB ARE FIXED POINT 0086 
» NOT * 0.0 MEANS ACOR AND COSTAB ARE FLTG. POINT 0087 

* 0088 

* SPACE(I) I=1...2*M+1 MUST BE AVAILABLE FOR TEMPORARY USE IF 0089 

* M IS LSTHN* N. SPACE(I) NOT USED FOR M GRTHN N. 0090 

* E QUI VALENCE (SPACE* ACOR ) IS PERMITTED (ACU> WILL BE LOST) 0091 

* 0092 

* OUTPUTS 0093 

* 0094 

* SPECT(I) 1 = 1... JMAX-JMIN+1 WILL CONTAIN SPU) J=JMIN. . . JMAX AS 0095 

* DEFINED IN ABSTRACT. (IT IS FIXED OR FLOATING 0096 

* ACCORDING TO TYPE) 0097 

* 0098 
» ISCALE IS NOT USED FOR FLOATING POINT DATA 0099 

* IS A SCALE FACTOR FOR FIXED POINT RESULTS, DETERMINED 0100 

* BY ASPECT SO AS TO AVOID OVERFLOW. 0101 

* =0 MEANS BINARY POINT OF SP(J) SAME AS AC(J) 0102 

* NOT = 0 MEANS BINARY POINT OF SP(J) IS I SCALE BITS 0103 

* TO THE RIGHT OF BINARY POINT OF AC(J) 0104 
» 0105 
» ERR * 0.0 NORMAL 0106 
« * 1.0 IF N,M,JMIN OR JMAX IS ILLEGAL 0107 

* 0108 

* EXAMPLES 0109 

* 0110 

* 1. COMPLETE SPECTRUM, NOT TRYING TO SAVE SPACE, FIXED OR FLOATING 0111 

* INPUTS - AC0RU...4) * 2. ,2. ,3. ,4. IAC0RU...4) » 200,200,300,400 0112 
» C0STAB( 1...3) = 1.0,0.0,-1.0 N=3 M*2 0113 
» C0ST8L( 1...3)=0CT377777777777, 000000000000, 777777777777 0114 

* JMIN = 0 , JMAX * 2 0115 
» USAGE - CALL ASPECT ( ACOR, N, COSTAB , M, JMIN , JMAX, 1. 0 , SPECT, 0116 

* SPACE, DUMMY, ERR1) 0117 

* CALL ASPECT ( I ACOR, N, COST BL , M, JMI N , JMAX, 0. , I SPECT, 0118 
» SPACE, ISCALE, ERR2) 0119 
» OUTPUTS - ERR1 = ERR2 = 0. 0120 

* SPECT ( 1...3)*20. ,-4., -4. ISPECT( 1. . .3 ) =2000,-400,-400 0121 

* ISCALE = 0 0122 

* 0123 
» 2. USE OF SPACE SAVING FEATURE 0124 

* INPUTS - SAME AS EXAMPLE 1. 0125 

* USAGE - CALL ASPECT ( ACOR, N, COSTAB, M, JMIN , JMAX, 1.0, SPECT, 0126 

* ACOR, DUMMY, ERR) 0127 

* CALL ASPECT( I ACOR , N, COSTBL , M, JMIN, JMAX, 0.0, ISPECT, 0128 

* IACOR, ISCALE, ERR) 0129 

* OUTPUTS - SAME AS EXAMPLE 1. (BUT ACOR AND IACOR ARE DESTROYED) 0130 

* 0131 

* 3. PARTIAL SPECTRUM 0132 

* INPUTS - SAME AS EXAMPLE I. EXCEPT JMIN*l 0133 

* USAGE - SAME AS EXAMPLE 1. 0134 

* OUTPUTS - SAME AS EXAMPLE 1. EXCEPT SPECT ( 1. . .2 )=-4. ,-4. 0135 

* ISPECTt 1...2)*-400,-400 0136 
» 0137 
» 4. FINER GRAINED SPECTRUM , M GRTHN N , FLTG PT 0138 

* INPUTS - SAME AS EXAMPLE 1. EXCEPT 0139 

* C0STAB( 1.. .5)=!. 0,. 70711, 0.0, -.70711, -1.0 M*4 0140 

* USAGE - SAME AS FIRST CALL IN EXAMPLE I. 0141 

* OUTPUTS - £RR*0. SPECTU...5) * 20. ,-. 82844,-4. , 4. 82844,-4. 0142 
» 0143 

* 5. FIXED POINT CASE INVOLVING SCALING 0144 

* INPUTS - SAME AS EXAMPLE 1. EXCEPT IAC0R(1...4) * 0145 

* 20000,20000,30000,40000 0146 

* USAGE - SAME AS SECOND CALL IN EXAMPLE 1. 0147 
» OUTPUTS - ERR2=0. I SPECT* 100000, -20000, -20000 ISCALE*! (I.E. 0148 
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• 




ISPECT VALUES SHOULD BE DOUBLEO FOR TRUE SCALE) 


0149 


• 








0150 


» 6. ERROR EXITS (WITH NO 


COMPUTATION) 


0151 


• USAGE - CALL 


ASPECT ( ACOR, -1, COSTAB, 3,0, 3, 1.0* SPECT, ACOR, 


0152 


• 






DUMMY, ERR1) 


0153 


• 




CALL 


ASPECT( AC0R,2,C0STAB,0,0,3, 1. 0, SPECT, ACOR, 


0154 


• 






DUMMY, ERR2) 


0155 


• 




CALL 


ASPECT (ACOR, 2, COSTAB, 3, -1,3, 1.0, SPECT, ACOR, 


0156 


* 






DUMMY, ERR3) 


0157 


• 




CALL 


ASPECT (ACOR, 2, COSTAB, 3, 0,4, 1.0, SPECT, ACOR, 


0158 


• 






DUMMY, ERR4) 


0159 


• 




CALL 


ASPECT ( ACOR, 2, COSTAB, 3,2,2, 1.0, SPECT, ACOR, 


0160 


• 






DUMMY, ERR5) 


0161 


* OUTPUTS - ERR1=1. (ILLEGAL N) ERR2=1. (ILLEGAL M) 


0162 


• 




ERR3=l. (ILLEGAL JMIN) ERR4»1. (ILLEGAL JMAX) 


0163 


• 




ERR5*1. (ILLEGAL JMAX) 


0164 


* 








0165 


• 








0166 


• PROGRAM FOLLOWS BELOW 




0167 


• 


NOTATION DIFFERENCES IN PROGRAM NOTES ARE 


0168 


• 




AACC=ACOR 




0169 


♦ 




SCALEMSCALE 


0170 


» 








0171 




HTR 


0 




0172 




BCI 


1, ASPECT 




0173 


ASPECT 


SXD 


•-2,4 




0174 




SXA 


LV+lt I 




0175 




SXA 


LV+2,2 




0176 


•MAKE 1 


PARTIAL 


ARGUMENT MAP (CHECKING N,M,JMIN> 


0177 


Al 


CLA 


lt4 


AACC 


0178 




STA 


Tl 




0179 




CLA* 


2,4 


N 


0180 




TMl 


A2A 




0181 




TZE 


A2A 




0182 




STO 


T2 




0183 




CLA 


3,4 


COSTAB 


0184 




STA 


T3 




0185 




CLA* 


4,4 


M 


0186 




TMI 


A2A 




0187 




TZE 


A2A 




0188 




STD 


T4 




0189 




CLA» 


5,4 


JMIN 


0190 




TMI 


A2A 




0191 




STD 


T5 




0192 




CLA» 


6,4 


JMAX 


0193 




STD 


T6 




0194 




CLA» 


7,4 


CONTENTS OF TYPE 


0195 




STO 


T7 




0196 




CLA 


8,4 


SPECT 


0197 




STA 


T8 




0198 




CLA 


9,4 


SPACE 


0199 




STA 


T9 




0200 




CLA 


10,4 


SCALE 


0201 




STA 


TIO 




0202 


•CHECK 


LEGALIT IES , JMIN LESS THAN JMAX LESS THAN OR=M 


0203 


A2 


CLA 


T6 


JMAX 


0204 




CAS 


T5 


JMIN 


0205 




TRA 


A2B 


OK 


0206 




NOP 




NO GOOD 


0207 


A2A 


CLA 


KLl 


NO GOOO 


0208 




STO* 


11,4 


SET ERR INDICATOR 


0209 




TRA 


LV 


EXIT 


0210 


A2B 


CAS 


T4 


M 


0211 




TRA 


A2A 


NO GOOD 


0212 




HOP 




OK 


0213 




STZ* 


11,4 


OK SET ERR=0.0 


0214 


• IF OK 


SET UP 


CONSTANTS 




0215 


A3 


CLA 


T4 


M 


0216 




ADD 


KD1 


M+l 


0217 




STD 


T15 




0218 




ADD 


T4 


2M+1 


0219 




STD 


T16 




0220 




SUB 


KD1 


2M 


0221 




STD 


T17 




0222 




CLA 


T2 


N 


0223 
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ADD 


KDl 


N+l 


0224 


STO 


T18 




0225 


CLA 


T6 


JMAX 


0226 


SUB 


T5 


JMAX-JMIN 


0227 


ADD 


KDl 


JMAX-JMIN+1 


0228 


STD 


T19 




0229 


CLA 


T4 


M/2 FOR M EVEN 


0230 


ARS 


1 


SET P= 


0231 


STD 


T14 


(M-l)/2 FOR M ODD 


0232 


•NOW ADDRESSES 






0233 


A4 CLA 


Tl 


AACC 


0234 


STA 


A6 




0235 


STA 


A7 




0236 


STA 


A8 




0237 


STA 


A9 




0238 


STA 


A23 




0239 


STA 


A26 




0240 


STA 


A27 




0241 


STA 


A28 




0242 


STA 


A29 




0243 


STA 


A30 




0244 


STA 


A31 




0245 


STA 


A34 




0246 


STA 


A35 




0247 


STA 


A37 




0248 


STA 


A38 




0249 


ADD 


Kl 


AACC+1 


0250 


STA 


All 




0251 


STA 


A19 




0252 


STA 


A21 




0253 


CLA 


TIO 


SCALE 


0254 


STA 


A18 




0255 


CLA 


T9 


SPACE 


0256 


STA 


A24 




0257 


STA 


A44 




0258 


STA 


A48 




0259 


STA 


A49 




0260 


STA 


A50 




0261 


STA 


A52 




0262 


STA 


A53 




0263 


STA 


A55 




0264 


STA 


A56 




0265 


ALS 


18 




0266 


SUB 


T17 


SPACE-2M 


0267 


ARS 


18 




0268 


STA 


A40 




0269 


ALS 


18 




0270 


ADD 


T4 


SPACE-M 


0271 


SUB 


KDl 


SPACE-M-1 


0272 


ARS 


18 




0273 


STA 


A51 




0274 


STA 


A55B 




0275 


CLA 


T9 


SPACE 


0276 


ALS 


18 




0277 


SUB 


T14 


SPACE-P 


0278 


SUB 


KDl 


SPACE-P-l 


0279 


ARS 


18 




0280 


STA 


A54 




0281 


STA 


A55A 




0282 


STA 


A57 




0283 


CLA 


T3 


COSTAB 


0284 


STA 


A32 




0285 


STA 


A58 




0286 


CLA 


T8 


SPECT 


0287 


STA 


A33 




0288 


STA 


A36 




0289 


STA 


A39 




0290 


STA 


A59 




0291 


♦WHEN ALL SET 


UP BEGIN 


BY DIVIDING AUTOCOR OF ZERO BY 2 


0292 


A5 ZET 


T7 


T7*CONTENTS OF TYPE 


0293 


TRA 


A8 




0294 


♦FIXED 






0295 


A6 CLA 


»» 


( ♦♦=AACC) 


0296 


ARS 


1 




0297 


A7 STO 


** 


(♦♦^AACC) 


0298 
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TRA AlO 0299 

•FLOATING 0300 

A8 CLA ♦ ♦ {♦•«AACC) 0301 

FDP KL2 0302 

A9 STQ •* (••=AACC) 0303 

TRA A22 AVOID SCALING CHECK 0304 

•IF DATA IS FIXED POINT DECIDE IF IT NEEDS DOWN- SCALING 0305 

•TO PREVENT OVERFLOW IN THE COSINE TRANSFORM. IT WILL BE 0306 

•DOWN SCALED IF TWICE THE SUM OF THE MAGNITUDES OF THE 0307 

•CORRELATION CFROM LAG 0 TO N) OVERFLOWS. 0308 

•MARK SUMMATION 0309 

AlO STZ SUMHI 0310 

TOV »+l 0311 

CLA KO 0312 

LXD T18,4 T18=PZE 0,0, N+l 0313 

All ADM »» f 4 (•♦=AACC*1) 0314 

TOV A13 0315 

A12 TIX All, 4,1 0316 

TRA A14 0317 

♦ADD L TO SUMHI FOR EACH OVERFLOW, AND GO BACK 0318 

A13 XCA 0319 

CLA Kl 0320 

ADD SUMHI 0321 

STO SUMHI 0322 

XCA 0323 

TRA A12 0324 

•WHEN DONE CHECK IF SUMHI ZERO 0325 

A14 ZET SUMHI 0326 

TRA A16 THERE WAS OVERFLOW 0327 

•FOR SUMHI ZERO CHECK BIT1 OF SUM IN AC 0328 

ALS 1 0329 

TOV A15 YES 0330 

CLA KO NO SEALING NEEDED 0331 

TRA A17 0332 

•IF BIT I IS 1 WE NEED TO SCALE DATA DOWN 1 BIT 0333 

A15 CLA Kl 0334 

TRA A17 0335 

♦IF OVERFLOW IN SUMHI WE NEED TO SCALE DOWN BY C(SUMHI)+l 0336 

A16 CLA SUMHI 0337 

ADD Kl 0338 

•SET SCALE CONSTANT AND THEN DO IT (UNLESS SCALE IS ZERO) 0339 

A17 STA A20 0340 

ALS 18 0341 

A18 STO •• (•♦=SCALE) 0342 

TZE A22 0343 

♦SCALE DOWN 0344 

LXD T18,4 T18*PZE 0,0, N+l 0345 

A19 CLA *» f 4 (♦♦=AACC*1) 0346 

A20 ARS ♦* UPSCALE CONSTANT) 0347 

A21 STO »» f 4 (•♦^AACC+l) 0348 

TIX A19,4,1 0349 

♦CHECK IF COLLAPSING IS VALID (ONLY FOR M LESS THAN OR =N) 0350 

A22 CLA T4 T4=PZE 0,0, M 0351 

CAS T2 T2=PZE 0,0*N 0352 

TRA CSP2 NOT VALID 0353 

NOP VALID 0354 

♦IF VALID GO DO IT (NOTE COLAPS FILLS IN ZEROS IF N LESS THAN 2M) 0355 

CLPS TSX $C0LAPS,4 0356 

A23 TSX •♦ (•♦^AACC) 0357 

TSX T18 T18=PZE 0,0, N+l 0358 

TSX T7 T7=C0NTENTS OF TYPE 0359 

A24 TSX ♦• (•»=SPACE) 0360 

TSX T17 T17^PZE 0,0, 2M 0361 

♦THEN RESTORE THE AUTOCOR OF ZERO LAG TO ITS ORIGINAL VALUE 0362 

♦UNLESS THE USER HAD US COLLAPSE IT ON TOP OF ITSELF (SPACE=AACC) 0363 

A25 CLA Tl T1=PZE AACC 0364 

CAS T9 T9=PZE SPACE 0365 

TRA *+2 OK TO RESTORE 0366 

TRA A40 AVOID RESTORING AC(O) 0367 

♦RESTORE FIXED OR FLOATING 0368 

ZET T7 T7=C0NTENTS OF TYPE 0369 

TRA A28 FLOATING 0370 

♦FIXED 0371 

A26 CLA •• (••=AACC) 0372 

ALS 1 0373 
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A27 


STO 


*» 


(*»=AACC> 


0374 




TRA 


A40 




0375 


•FLOATING 






0376 


A28 


LDQ 


*• 


( *»=AACC> 


0377 




FMP 


KL2 




0378 


A29 


STO 


• * 


(•~=AACC> 


0379 




TRA 


A40 




0380 


•IF COLLAPSING IS NOT VALID COMPUTE SPECTRUM DIRECTLY FROM 


0381 


•AACCf 


THEN 


DOUBLE THE 


SPECTRUM, RESTORE AC<0) AND EXIT 


0382 


• (DONT 


WORRY 


ABOUT AC(O) SINCE SPACE WAS NOT USED) 


0383 


CSP2 


TSX 


$C0SP,4 




0384 


A30 


TSX 


*• 


( • ♦==AACC) 


0385 


A3I 


TSX 


*• 


< •»=AACC) 


0386 




TSX 


T2 


T2-PZE 0,0,N 


0387 


A32 


TSX 


*• 


( ♦♦=CGSTAB) 


0388 




TSX 


T4 


T4=PZE 0,0, M 


0389 




TSX 


T5 


T5*PZE 0,0,JMIN 


0390 




TSX 


T6 


T6=PZE 0,0,JMAX 


0391 




TSX 


T7 


T7=C0NT£NTS OF TYPE 


0392 


A33 


TSX 


*« 


{ **=SPECT) 


0393 


•FIXED 


OR FLOATING 




0394 




ZET 


T7 




0395 




TRA 


A37 


FLOATING 


0396 


•FIXED 








0397 


A34 


CLA 


»« 


( •*=AACC) 


0398 




ALS 


1 




0399 


A35 


STO 


• » 


( •♦=AACC) 


0400 


08X1 


TSX 


DUBLX,4 




0401 


A36 


TSX 


*» 


( ♦*=SPECT) 


0402 




TSX 


T19 


T19=sJMAX-JMIN*l 


0403 




TRA 


LV 


GO EXIT 


0404 


♦FLOAT! 


[NG 






0405 


A37 


LOQ 


• * 


i ••*AACC) 


0406 




FMP 


KL2 




0407 


A38 


STO 


*• 


(*»=AACC) 


0408 


DBL1 


TSX 


DUBLL 1 4 




0409 


A39 


TSX 


• * 


( ••sSPECT) 


0410 




TSX 


T19 


T19=JMAX-JMIN+1 


0411 




TRA 


LV 


GO EXIT 


0412 



•IF COLLAPSING WAS PERFORMED 0413 



•THEN END-POINT ADJUST THE COLLAPSED CORRELATION AND DOUBLE IT 0414 

A40 STZ •♦ ( ♦*=SPACE~2M ) 0415 

ZET T7 T7-C0NTENTS OF TYPE 0416 

TRA DBL2 0417 

•FIXED POINT 0418 

DBX2 TSX $DUBLX f 4 0419 

A44 TSX ♦♦ (♦♦=SPACE) 0420 

TSX T16 T16=PZE 0,0,2M+1 0421 

TRA SPLT1 0422 

•FLOATING POINT 0423 

DBL2 TSX $DUBLL,4 0424 

A48 TSX •» (*»=SPACE) 0425 

TSX T16 Ti6=PZE 0,0,2M+1 0426 

♦NOW SPLIT THE ADJUSTED COLLAPSEO AUTOCORRELATION ON TOP OF ITSELF 0427 

SPLTl TSX $SPLIT,4 0428 

A49 TSX •♦ (••^SPACE) 0429 

TSX T16 T16=PZE 0,0,2M+1 0430 

TSX T7 T7-C0NTENTS OF TYPE 0431 

A50 TSX *♦ (»*^SPACE) 0432 

A51 TSX ♦• ( *»=SPACE~M-1) 0433 

•NOW RESPLIT THE SYMMETRIC PART ON TOP OF ITSELF 0434 

SPLT2 TSX $SPLIT,4 0435 

A52 TSX »♦ (»»=SPACE) 0436 

TSX T15 T15*PZE 0,0, M+l 0437 

TSX T7 T7=C0NTENTS OF TYPE 0438 

A53 TSX »• (**=SPACE) 0439 

A54 TSX •* (♦♦=SPACE-P-1> 0440 

•REVERSE THE RESPLIT PARTS AND SET AS(P)=0 FOR COSP 0441 

REV TSX $RVPRTS,4 0442 

A55 TSX •• (♦•^SPACE) 0443 

A55A TSX »» ( »»=SPACE-P-1) 0444 

TSX T15 (T15=PZE 0,0, M+l) 0445 

A55B STZ •• ( •♦^SPACE-M-1) 0446 

♦NOW COMPUTE SPECTRUM FROM THE RESPLIT PARTS 0447 

CSP1 TSX $C0SP,4 0448 
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1 OA 




f * «— C D ATE 1 






0449 


A57 


1 jA 




I *»-3rALt"r 






0450 




TC Y 
i OA 




T 1 A — D7C A fl 


» P 




0451 


ADO 


1 OA 




1 »*— \,u$ I Ad J 






0452 




TSX 


T A 


1 H-Pit Uf Of! 


M 




0453 




TSX 


T5 


T C — D 7t A A 
1 D-rtt U f Uf 


J M I N 




0454 




TSX 


T6 


1 O s r AC U f Of 


JMAX 




0455 




TSX 


T7 


T7-rflMTCMTC 


nc tvoc 
Ur lire 




0456 


A59 


TSX 


• » 


I **— irtv, 1 J 






0457 


♦FINAL 


EXIT 










AA c a 
U«r!>o 


LV 


LXD 


ASPECT-2, 4 








0459 




AXT 


••t 1 








0460 




AXT 


••t2 


(♦**XR2) 






046 1 




TRA 


12,4 








AAA O 


•TEMPORAR IES , 


ETC 








0463 


•INPUT 


ARGUMENTS 








0464 


Tl 


PZE 


** 


(#*=AACC) 








T2 


PZE 


Of u t ** 


(••=N) 






U*f OO 


T3 


PZE 




(•»=COSTAB) 






AAA"? 


T4 


PZE 




(•♦=M) 






0468 


T5 


PZE 


U , U , ** 


(»»=JMIN) 






0469 


T6 


PZE 


ft A M. A 


(•♦=JMAX) 






0470 


T7 


PZE 




(••^CONTENTS OF TYPE*' 


0.0<FXD)»1.0<FLTG3) 


AA "71 

Uf f l 


T8 


PZE 




{♦ASPECT ) 






U*, f c. 


T9 


PZE 




( »»=SPACE) 






0473 


TIO 


PZE 




(♦♦^SCALE) 








T14 


PZE 


U f U t * * 


(♦»=P FOR C0SP*M/2 OR 


(M-D/2) 


0475 


T15 


PZE 


0 tO t ** 


(***M+1 FOR 


REV, SPLT2 t ) 


A A Tf A 
U*f f 6 


T16 


PZE 


Of 0 1 ** 


(•♦=SM+1 FOR SPLT2, DUBLX, DUBLLf ) 


flATFTf 
U*» f f 


T17 


PZE 


Uf U f * * 


(»»=2M FOR ' 


CLPS) 




0478 


T18 


PZE 


0 f 0 f ** 


(♦•=N+1 FOR 


CLPS, SCALING,) 


a.ato 
Uh f V 


T19 


PZE 




{ »»=JMAX-JMIN+1 ) 




0480 


SUMHI 


PZE 




OVERFLOW REG FOR COR. 


MAGN. SUM 


0481 


KO 


PZE 


A 
U 








0482 


Kl 


PZE 










0483 


KOI 


PZE 


OfO,l 








0484 


KL1 


DEC 


1.0 








0485 


KL2 


DEC 


2.0 








0486 


• 












0487 


* 












aao a 


•USE OF SPACE 


WHEN M IS EVEN 


(P^M/2) 






0489 


* 












0490 


* 


AFTER 


AFTER END 


AFTER 


AFTER 


AFTER 


0491 


» 


COLAPS 


POINT ADJUST 


FIRST 


SECOND 


RVPRTS 


0492 


» 




AND DUBL 


SPLIT 


SPLIT 


AND END 


0493 


* 










POINT SET 


0494 


• -2M 


BLANK 


0.0 


Al(M) 






0495 


• -2M 


BLANK 


0.0 


AKM) 


(SAME 




0496 


•-2M+1 


XC(2M- 


1) 2XC(2M-1) 




BUT 




0497 


• 








THESE 






♦ ETC 








NOT 




0499 


* 






AK2) 


USED) 




0500 








Aid) 


Al< 1) 


0.0»AS<P) 


UDU 1 


• -M 


XC(M) 


2XC(M) 


SUM) 


A2(P) 


A2< 1)=AS(P-1) 




• ETC 












Ut>U^ 


♦ -P-i 






SKP + l) 


A2d) 


A2(P)=AS(0) 


0504 


* -p 


XC(P) 


2XC(P) 


SUP) 


S2<P) 


S2(0)=SS(P) 


0505 


• ETC 












0506 


• -I 


XCd) 


2XC(1) 


Sl( 1) 


S2( 1) 


S2(P-11*SS( 1) 


0507 


♦SPACE 


XC(O) 


2XC(0) 


SKO) 


S2<0) 


S2<P)*SS(0> 


UDUO 


* 












0509 


•THUS 1 


WHEN M 1 


EVEN RSS * SPACE, RAS = 


SPACE-P-1 




\JD l u 


* 














* 














•USE OF SPACE 


WHEN M IS ODD 


(Q»IM*l)/2» 


P=(M-1 )/2=Q-l> 


05 1 3 


» 












0514 


» 


AFTER 


AFTER END 


AFTER 


AFTER 


AFTER 


0515 


» 


COLAPS 


POINT ADJUST 


FIRST 


SECOND 


RVPRTS 


0516 


* 




AND DUBL 


SPLIT 


SPLIT 


AND END 


0517 


• 










POINT SET 


0518 


» -2M 


BLANK 


0.0 


Al(M) 






0519 


•-2M+1 


XC(2M- 


1) 2XC(2M-1) 


AKM-1 






0520 


• 








SAME 


SAME 


0521 


• ETC 












0522 








Al(l) 


All I) 


0.0=N0T USED 


0523 
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* — M XC(M) 


2XC(M) 


SUM) 


A2(Q) 


A2(l) 


•-M+1 XC(M-l) 










♦ETC 










» 






A2<2> 


A2<Q-1) 


»-Q(=-P-H) 






A2< 1) 


A2(Q) 


«-Q+H=-P) 






S2(Q) 


S2( 1) 


•ETC 










* -1 XCU) 


2XC(1) 


Sl(i) 


S2(2) 


S2(Q-1) 


•SPACE XC(O) 


2XC(0) 


SKO) 


S2( I) 


S2(Q) 


•THUS WHEN M ODD 


RSS = 


SPACE, RAS 


= SPACE-P-l 





END 



♦ ASPECT • 
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ASf P) 


0524 




0525 




0526 


AS( I) 


0527 


ASiO) 


0528 


SS(P) 


0529 




0530 


SS( 1) 


0531 


SS(O) 


0532 




0533 




0534 




0535 
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* ASPEC2 { SUBROUTINE ) 3/15/65 LAST CARD IN DECK IS NO. 0205 
« FAP 0001 
♦ASPEC2 0002 

COUNT 250 0003 

LBL ASPEC2 0004 

ENTRY ASPEC2 UCOR, MXLAG, FREQLO, FRQDEL, NFREQS, IERRLO, 0005 

« SPECT, IANS) 0006 

« 0007 

* ABSTRACT 0008 

« 0009 

« TITLE - ASPEC2 0010 

« AUTOSPECTRUM BY COSINE TRANSFORM OF AUTOCORRELATION 0011 

* 0012 

* ASPEC2 COMPUTES THE COSINE TRANSFORM VALUES 0013 

* 0014 
« MXLAG 0015 

* SPECTCJ) = AC(O) + 2 * SUM AC< I ) *COS ( W( J ) *I ) 0016 
« 1=1 0017 

* 0018 

* FOR J = 1, 2,...,NFREQS 0019 
« 0020 
« WHERE 0021 

* W(J) = FREQLO ♦ C J~l )*FRQDEL, AND 0022 
» AC(I)t MXLAG t FREQLO, FRQDEL, AND NFREQS ARE INPUTS 0023 
« 0024 
« THE COMPUTATIONS ARE SPEEDED UP BY THE USE OF SUBROUTINE 0025 

* SEQSAC AND FUNCTION NEXCOS TO GENERATE COSINE VALUES. 0026 

* WHILE THREE OR FOUR TIMES SLOWER THAN SUBROUTINE ASPECT, 0027 
» THE COMPUTATIONS HERE REQUIRE NO TEMPORARIES. 0028 

* 0029 
» LANGUAGE - FAP SUBROUTINE C FORTRAN- I I COMPATIBLE) 0030 

* EQUIPMENT - 709,7090,7094 1MAIN FRAME ONLY) 0031 

* STORAGE - 74 REGISTERS 0032 

* SPEED - ON THE 7090 ASPEC2 TAKES ABOUT 0033 

* 100 ♦ 118»NFREQS + 140*NFREQS* (MXLAG+i ) MACHINE CYCLES 0034 

* WHERE NFREQS AND MXLAG ARE DEFINED ABOVE 0035 
» AUTHOR - S.M. SIMPSON, JUNE 1964 0036 

* 0037 

* 0038 

* USAGE 0039 

* 0040 

* TRANSFER VECTOR CONTAINS ROUTINES - SEQSAC, NEXCOS 0041 
» AND FORTRAN SYSTEM ROUTINES - NOT ANY 0042 
» 0043 

* FORTRAN USAGE 0044 
» CALL ASPEC2UC0R, MXLAG, FREQLO, FRQDEL, NFREQS, IERRLO, SPECT, 0045 
« 1 IANS) 0046 

* 0047 

* 0048 

* INPUTS 0049 
« 0050 
« ACOR(I) I=1...MXLAG+1 CONTAINS THE AUTOCORRELATIONS AC(J), 0051 

* J=0.. .MXLAG. 0052 

* 0053 
« MXLAG MUST BE GRTHN OR EQUAL ZERO 0054 

* 0055 

* FREQLO IS THE LOWEST FREQUENCY, W(l) OF THE ABSTRACT, IN RADIANS 0056 

* 0057 
« FRQDEL IS THE FREQUENCY INCREMENT IN RADIANS 0058 

* 0059 
« NFREQS IS THE DESIRED NUMBER OF OUTPUT SPECTRAL VALUES 0060 
« MUST EXCEED ZERO 0061 
« 0062 

* IERRLO IS THE DESIRED IANS OUTPUT FOR ILLEGAL MXLAG 0063 

* 0064 

* 0065 

* OUTPUTS NO COMPUTATIONS ARE MADE FOR ILLEGAL MXLAG OR NFREQS 0066 

* VALUES. 0067 

* 0068 

* SPECT(J) J-l. • .NFREQS CONTAINS THE VALUES DEFINED IN THE ABSTRACT 0069 
« 0070 

* IANS = 0, IF ALL OK 0071 
« * IERRLO, IF MXLAG ILLEGAL 0072 
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« 








= IERRLO+1, IF NFREQS ILLEGAL 


0073 


• 










0074 


• 










0075 


# 


EXAMPLES 






0076 


• 










0077 


« 


L 


INPUTS 


- 


AC0R(1...4) = 1.0,. 5, .5, .5 


0078 


« 








FREQLO * 3.14159265/6.0 (30 DEGREES) 


0079 


* 








FREQDEL = 2.0*FREQL0 NFREQS= t 2 IERRLO-1 


0080 


• 




USAGE 


- 


DIMENSION SPECT(2,4), IANS(4) 


0081 


* 








DO 10 LAC0R=1,4 


0082 


* 








MXLAG * LACOR-1 


0083 


« 








10 CALL ASPEC2(AC0R, MXLAG, FREQLO, FRQDEL, NFREQS, 


0084 


• 








1 IERRLO, SPECT(1,LAC0R), IANS(LACOR) ) 


0085 


* 




OUTPUTS 


- 


SPECT(1...2,1) = 1.000, 1.000 


0086 


* 








SPECT(1...2,2) « 1.866, 1.000 


0087 


* 








SPECT(1...2,3) * 2.366, 0.000 


0088 


» 








SPECT(1...2,4) « 2.366, 0.000 


0089 


• 








IANSU...4) = 0,0,0,0 


0090 


« 










0091 


• 


2. 


INPUTS 




SAME AS EXAMPLE 1. EXCEPT AC0RU...4) = 2.,1.,1.,1. 


0092 


* 








NFREQS«1 


0093 


• 




USAGE 




SAME AS EXAMPLE 1. 


0094 


• 




OUTPUTS 




SPECTU,1...4) - 2.000,3.732,4.732,4.732 


0095 


• 








IANSU...4) = 0,0,0,0 


0096 


« 










0097 


• 


3. 


ILLEGAL 


CASES (D IS A DUMMY VARIABLE BELOW) 


0098 


• 




USAGES 




CALL ASPEC2(D,-1,D,D,1,3,D,IANS1) 


0099 


• 








CALL ASPEC2(D,0,D,D,0,3,D,IANS2) 


0100 


s 




OUTPUTS 




IANS1*3 IANS2=4 


0101 


* 










0102 


• 










0103 


* 


PROGRAM FOLLOWS BELOW 


0104 


• 










0105 


« 


TRANSFER VECTOR CONTAINS SEQSAC, NEXCOS 


0106 


• 










0107 






HTR 




0 XR1 


0108 






HTR 




0 XR2 


0109 






HTR 




0 XR4 


0110 






BCI 




1,ASPEC2 


0111 


* 










0112 


* 


ONLY ENTRY. 


ASPEC2(AC0R, MXLAG, FREQLO, FRQDEL, NFREQS, IERRLO, 


0113 


* 








SPECT, IANS) 


0114 


• 










0115 


ASPEC2 SXD 




ASPEC2-4,i 


0116 






SXD 




ASPEC2-3,2 


0117 






SXD 




ASPEC2~2,4 


0118 


• 










0119 


« 


DIVIDE ACOR(l) BY 2, SET ADDRESSES, DECREMENTS, CHECK MXLAG, NFREQS 


0120 


• 










0121 






CLA* 




1,4 ACOR(l) 


0122 






STO 




AC0R1 (SAVE IT) 


0123 






FDP 




KL2 


0124 






STQ* 




lf4 


0125 






CLA 




1,4 A(ACOR) 


0126 






ADD 




Kl AUCORm 


0127 






STA 




FMP 


0128 






CLA 




7,4 A( SPECT) 


0129 






ADD 




Kl A(SPECT)+1 


0130 






STA 




STO 


0131 






CLA* 




6,4 IERRLO 


0132 






PDX 




0,1 TO XR1 


0133 






CLA* 




2,4 MXLAG 


0134 






ADD 




KD1 MXLAG* 1 


0135 






STD 




TXL1 


0136 






TMI 




LEAVE 


0137 






TZE 




LEAVE 


0138 






TXI 




•♦1,1,1 


0139 






CLA* 




5,4 NFREQS 


0140 






STD 




TXL2 


0141 






SUB 




KD1 


0142 






TZE 




CLAFL 


0143 






TMI 




LEAVE 


0144 


« 










0145 


• 


ALL OK, INITIALIZE FOR FREQUENCY INCREMENTING 


0146 


* 










0147 



»•*»•*»•••»**••*•••• PROGRAM LISTINGS »*♦»•«**»»•« 

ASPEC2 » * ASPEC2 



C PAGE 31 {PAGE 



CLAFL 


CLA» 


3,4 


FREQLO 


0148 




STO 


FREQ 




0149 




CLA» 


4,4 


FRQDEL 


0150 




STO 


FRQDEL 




0151 


• 








0152 


« OUTER LOOP 


COUNTS SPECTRAL 


VALUES WITH XR2 * 1...NFREQS 


0153 


« 








0154 




AXT 


1,2 




0155 


TSX1 


TSX 


$SEQSAC,4 




0156 




TSX 


KZ,0 




0157 




TSX 


FREQ, 0 




0158 


• 








0159 


* INNER LOOP 


COUNTS ACOR VALUES WITH XR1 * 1 • • .MXLAGS+L 


0160 


• 








0161 




AXT 


1,1 




0162 




ST2 


SUM 




0163 


TSX2 


TSX 


$NEXC0S,4 




0164 




XCA 






0165 


FMP 


FMP 




•» = A(AC0R>*1 


0166 




FAD 


SUM 




0167 




STO 


SUM 




0168 




TXI 


•♦1,1,1 




0169 


TXL1 


TXL 


TSX2,1,*» 


*» * MXLAG+1 


0170 


* 








0171 


• STORE RESULT AND INDEX FOR 


MORE 


0172 


* 








0173 




XCA 






0174 




FMP 


KL2 




0175 


STO 


STO 


»»,2 


•• = A(SPECT)+1 


0176 




CLA 


FREQ 




0177 




FAD 


FRQDEL 




0178 




STO 


FREQ 




0179 




TXI 


•+1,2,1 




0180 


TXL2 


TXL 


TSX1,2,»» 


»* = NFREQS 


0181 




AXT 


0,1 


(IANS = 0) 


0182 


• 








0183 


* EXIT, 


, SETTING IANS AND RESTORING ACOR(l) 


0184 


• 








0185 


LEAVE 


PXD 


0,1 




0186 




LDQ 


AC0R1 




0187 




LXD 


ASPEC2-4,1 




0188 




LXD 


ASPEC2-3,2 




0189 




LXD 


ASPEC2-2,4 




0190 




STO* 


8,4 




0191 




STQ* 


1,4 




0192 




TRA 


9,4 




0193 


• 








0194 


• CONSTANTS, 


TEMPORARIES 




0195 


• 








0196 


KZ 


PZE 


0 




0197 


Kl 


PZE 


1 




0198 


KD1 


PZE 


0,0,1 




0199 


KL2 


DEC 


2.0 




0200 


FRQDEL 


PZE 


*»,•*,*• 


INPUT 


0201 


FREQ 


PZE 


*• , ** , »» 


FREQLO, FREQLO+FRQDEL,... 


0202 


SUM 


PZE 


**,##, 




0203 


ACOR1 


PZE 


#*,•* f 


ACOR(l) 


0204 




END 






0205 



• AVRAGE 



PROGRAM LISTINGS 



• AVRAGE • 

•••4 •«••»»•» •••••»••»»•* 



• AVRAGE (SUBROUTINE ) 9/29/64 LAST CARO IN DECK IS NO. 0078 

* FAP OOOi 
•AVRAGE 0002 

COUNT 150 0003 

LBL AVRAGE 0004 

ENTRY AVRAGE (X,LX,XAVG) 0005 

• 0006 

♦ ABSTRACT 0007 

• 0008 
» TITLE - AVRAGE 0009 

* FIND AVERAGE OF FLOATING VECTOR 0010 

* 0011 
» AVRAGE COMPUTES THE MEAN OF A FLTG VECTOR. 0012 

• 0013 

* LANGUAGE - FAP SUBROUTINE (FORTRAN— I I COMPATIBLE) 0014 
« EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0015 

• STORAGE - 24 REGISTERS 0016 

* SPEEO - 52.4 ♦ 8.4*LX MACHINE CYCLES ON 7090t LX * VECTOR LENGTH 0017 

• 57.4 + 8.4»LX ON 709 0018 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 0019 

* 0020 

* USAGE 0021 

• 0022 

• TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0023 

♦ AND FORTRAN SYSTEM ROUTINES - (NONE) 0024 
» 0025 

• FORTRAN USAGE 0026 
» CALL AVRAGE(X,LX,XAVG) 0027 

* 0028 
» INPUTS 0029 

• 0030 

• X(I) 1*1.. .LX IS A FLTG VECTOR 0031 

* 0032 
« LX SHOULD EXCEED ZERO 0033 

* 0034 

♦ OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LX LSTHN 1 0035 

* 0036 
» XAVG IS (l/LX)*SUM (FROM I»l TO LX) OF X(I) (FLTG) 0037 
» 0038 

* EXAMPLES 0039 

• 0040 

• 1. INPUTS - X(1...4)»l., 2., 3. ,4. U=0. 0041 
» USAGE - CALL AVRAGE( X,4,XAVG ) 0042 

* CALL AVRAGE( X, 1,Y ) 0043 

♦ CALL AVRAGE(X,0,U) 0044 

• OUTPUTS - XAVG»2.5 Y=l. U=0.0 (NO OUTPUT CASE) 0045 

• 0046 
» PROGRAM FOLLOWS BELOW 0047 
« 0048 
» NO TRANSFER VECTOR 0049 

HTR 0 XR4 0050 

BCI 1, AVRAGE 0051 

» ONLY ENTRY. AVRAGE ( X, LX , XAVG ) 0052 

AVRAGE SXD AVRAGE-2,4 0053 

Ki CLA 1,4 0054 

ADD Kl A(X)*l 0055 

STA ADD1 0056 

* CHECK LX AND FLOAT IT 0057 

CLA* 2,4 LX 0058 

TMI LEAVE 0059 

PDX 0,4 LOOP SET 0060 

TXL LEAVE, 4,0 0061 

LRS 18 0062 

ORA OCTK 0063 

FAD OCTK FLOATED LX 0064 

STO FLX 0065 

» SUM X(l...LX), DIVIDE, STORE, EXIT 0066 

PXD 0,0 0067 

A DDI FAD **»4 *»=A(X)+1 0068 

TIX ADD1,4,1 0069 

FDP FLX 0070 

LXD AVRAGE-2,4 0071 

STQ* 3,4 0072 

LEAVE LXD AVRAGE-2,4 0073 

TRA 4,4 0074 



•»**»»•«****»»•*«»*«***« PROGRAM LISTINGS »#*#»♦***♦*»*#*»«*»«***» 

* AVRAGE * * AVRAGE * 

♦*#♦##«*#*»«*♦**#*»♦*#** *»♦#»##*#»•***»»♦*##*♦#» 
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* CONSTANTS, VARIABLES 0075 

OCTK OCT 233000000000 0076 

FLX PZE ** ' LX FLOATED 0077 

END 007 8 



»***••»•**•»•»»*»»*»**•• PROGRAM LISTINGS #»**»#»*****•♦»»«*♦****» 

* BLKSUM • ♦ BLKSUM * 

»»»»»«#»»#»♦•##**»♦**»»» ##*»#****♦*****»♦»#»»*»* 



* BLKSUM (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO. 0168 

* FAP 0001 
•BLKSUM 0002 

COUNT 200 0003 

LBL BLKSUM 0004 

ENTRY BLKSUM (X, LX, LBLOKt DVSR, XBSMODt LXBS001 0005 

* 0006 
» 0007 

* ABSTRACT 0008 

« 0009 

* TITLE - BLKSUM 0010 

* SUMMATION OF VECTOR OVER ABUTTING BLOCKS OF CONSTANT LENGTH 0011 

* 0012 
» BLKSUM COMPUTES 0013 

* 0014 
» I I*L 0015 

* S(I) » SUM X(J) 0016 

» D J=U-1)*L + 1 0017 

* 0018 

* FOR I = 1,2,...,N=(LX/L)R0UNDED DOWN 0019 

* 0020 
» WHERE X(1...LX), LX, L, AND 0 ARE INPUTS. 0021 

* 0022 

* THE OUTPUT VECTOR MAY REPLACE THE INPUT VECTOR* AND THE 0023 

* LENGTH N IS AN ADDITIONAL OUTPUT FROM BLKSUM. 0024 
» 0025 

* 0026 
» LANGUAGE - FAP SUBROUTINE (FORTRAN-II COMPATIBLE) 0027 
» EQUIPMENT - 709,7090,7094 (MAIN FRAME ONLY) 0028 
» STORAGE - 49 REGISTERS 0029 

* SPEED - REQUIRES 80 ♦ 29«N ♦ 8.4*L*N MACHINE CYCLES ON THE 7090 0030 

* WHERE L AND N ARE DEFINED ABOVE. 0031 

* AUTHOR - S.M. SIMPSON, JULY 1964 0032 
« 0033 

* 0034 

* USAGE 0035 

» 0036 

* TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0037 

* AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0038 
» 0039 

* FORTRAN USAGE 0040 

* CALL BLKSUMIX, LX, LBLOK, DVSR, XBSMOD, LXBSOD) 0041 
» 0042 

* 0043 

* INPUTS 0044 

* 0045 

* Xtl) 1=1. ..LX IS A FLOATING POINT VECTOR. 0046 
» 0047 

* LX MUST BE GRTHN= 1 . 0048 

* 0049 

* LBLOK IS THE BLOCK LENGTH L OF THE ABSTRACT. 0050 

* MUST EXCEED ZERO AND BE LSTHN= LX. 0051 

* 0052 
» DVSR IS THE DIVISOR D OF THE ABSTRACT. 0053 

* MUST BE NON-ZERO. 0054 

* 0055 
» 0056 
» OUTPUTS STRAIGHT RETURN WITH NO OUTPUTS IF LX, LBLOK, OR DVSR 0057 

* ILLEGAL. 0058 

* 0059 
» XBSMOD(I) 1*1. ..LXBSOD ARE THE SUMS S(1...N) OF THE ABSTRACT. 0060 

* EQUIVALENCE (X, XBSMOD) IS PERMITTED. 0061 

* 0062 

* LXBSOD WILL * (LX/LBLOK) ROUNDED DOWN. 0063 

* 0064 

* 0065 

* EXAMPLES 0066 

* 0067 

* 1. MISCELLANEOUS VALUES OF LX, LBLOK 0068 
» INPUTS - XU...4) = 2. ,4. ,6., 8. DVSR=2.0 0069 

* S(1...4,1...4,1...4) * -9. ,-9.,... 0070 

* LS(1...4,1...4) * -9,-9,... 0071 

* USAGE - DO 10 LX=1,4 0072 

* DO 10 L=l f LX 0073 

* 10 CALL BLKSUM ( X, LX,L, DVSR, S( !,LtLX),LSfLfLX) ) 0074 



» BLKSUM 



PROGRAM LISTINGS 



«*••»•»»•*«< 

• BLKSUM 



IPAGE 2) 



I PAGE 2) 



• 


OUTPUTS - S<1.*«4,1...4,1) 


3 






* 










* 


StK.,4,i...4,2) 


3 


1., 2.,— 9.,— 9.,, 


3. ,-9*, -9. ,-9.,, 


* 










* 


S(1...4,1...4,3> 


3 


1., 2., 3.,-9.,, 


3.»-9i,-9.,-9. , , 


• 










* 


SU...4,1...4,4) 


3 






# 






6. ,—9. ,—9. ,-9. t , 


10., -9* ,-9., -9. 


• 


LS< 1..44, 1...4) 


3 


1,-9,-9,-9,, 2, 


1,-9,-9,, 


• 






3, 1, 1,-9,, 4, 


2, 1, 1 



* 2. OUTPUT REPLACING INPUT 

* INPUTS - SAME AS EXAMPLE 1. 

» USAGE - CALL BLKSUM ( X,4, 2,0VSR, X, LS ) 

» OUTPUTS - XC1...4) = 3. ,7. ,6. ,8. LS * 2 
• 

* 3. ILLEGAL CASES 

* INPUTS - SAME AS EXAMPLE 1. 

« USAGE - CALL BLKSUM* X ,2, 1.0, S,LS) 

» CALL BLKSUM* X, 3,0, 1.0, S,LS) 

* CALL BLKSUM1X, 3,4, 1.0, S,LS) 

* CALL BLKSUMU, 3,2,0.0, S,LS) 

* OUTPUTS - S * -9. LS * -9 



• PROGRAM FOLLOWS BELOW 



• NO TRANSFER VECTOR 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 



HTR 


0 




XR2 


0104 


HTR 


0 




XR4 


0105 


BCI 


I, BLKSUM 






0106 


» 








0107 


* ONLY ENTRY. 


BLKSUM (X, LX, 


LBLOK, DVSR, XBSMOD, LXBSOD) 


0108 


• 








0109 


BLKSUM SXD 


BLKSUM-3 


t2 




0110 


SXD 


BLKSUM-2 


,4 




0111 


• 








0112 


♦ CHECK AND SET OVSR, 


LBLOK 


, LXBSOD AND SET ADDRESSES 


0113 


* 








0114 


CLA» 


4,4 




DVSR 


0115 


TZE 


LEAVE 






0116 


STO 


DVSR 






0117 


CLA* 


3,4 




LBLOK 


0118 


ARS 


18 






0119 


STO 


LBLOK 






0120 


TMI 


LEAVE 






0121 


TZE 


LEAVE 






0122 


CLA* 


2,4 




LX 


0123 


CAS* 


3,4 




AGAINST LBLOK 


0124 


NOP 






OK 


0125 


TRA 


LRS 




OK 


0126 


TRA 


LEAVE 




NG 


0127 


LRS LRS 


35 






0128 


DVP» 


3,4 




LX/LBLOK ROUNDED DOWN 


0129 


CLM 








0130 


LLS 


18 






0131 


XCA 








0132 


STO* 


6,4 




EQUALS LXBSOD 


0133 


STO 


TXL 






0134 


CLA 


1,4 




A(X) 


0135 


ADO 


Kl 




A(X)U 


0136 


STA 


FAD 






0137 


CLA 


5,4 




A( XBSMOD) 


0138 


ADO 


Kl 




A<XBSM0D>+1 


0139 


STA 


STQ 






0140 


AXT 


1,2 




XR2 WILL CONTROL OUTPUT STORAGE 


0141 


• 








0142 


» DOUBLE LOOP 


STARTS. 


XR2=1. 


..LXBSOD, XR4»L8L0K...l REPEATED 


0143 


* 








0144 


PXD PXD 


0,0 




{SUMMATION IN AC) 


0145 


LXA 


LBLOK, 4 






0146 


FAD FAD 


**,4 




** = A(Xm, -LBLOK, -2*LBL0K,... 


0147 


TIX 


FAD, 4,1 






0148 


FDP 


DVSR 






0149 



BLKSUM 
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PROGRAM LISTINGS 
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* BLKSUM ♦ 



(PAGE 3) 



STQ 



STQ 
CAL 
SUB 
STA 
TXI 

TXL TXL 

* 

# EXIT 
» 

LEAVE LXD 
LXO 
TRA 



**»2 

FAD 

LBLOK 

FAD 

♦♦1.2,1 
PXD,2,»« 



BLKSUM-3,2 
BLKSUM-2,4 
7,4 



»• » A(XBSMQD)+1 



* LXBSOD 



• CONSTANTS TEMPORARIES 



Kl PZE 
DVSR PZE 
LBLOK PZE 
END 



,**,« 

,0,0 



0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 



•**•••»•••»•**»»*•»»•**» PROGRAM LISTINGS #»♦#»*#*»«##*»»»»•»♦♦#*• 

» BOOST » * BOOST » 

•••*»••••*•»•*»••**»•*•» »***••»**•*»*»•*•**••••• 

* BOOST (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0146 

* FAP 0001 
•BOOST 0002 

COUNT 150 0003 

LBL BOOST 0004 

ENTRY BOOST ( X, LX, XRIZE, XBUSTD) 0005 

ENTRY XBOOST (IX, LIX, IXRIZE, IXBSTD) 0006 

ENTRY DPRESS ( X, LX, XSINK, XLWRO) 0007 

ENTRY XDPRSS (IX, LIX, IXSINK, IXLWRD) 0008 

« 0009 

* ABSTRACT 0010 

* 0011 
» TITLE - BOOST WITH SECONOARY ENTRIES XBOOST, DPRESS, AND XOPRSS 0012 

* ADD A CONSTANT TO ELEMENTS Of A FXD OR FLTG VECTOR 0013 

* 0014 
» BOOST ADDS A FLTG CONSTANT TO A VECTOR* 0015 

* XBOOST ADDS A FXD CONSTANT TO A VECTOR. 0016 

* DPRESS SUBTRACTS A FLTG CONSTANT FROM A VECTOR. 0017 
» XDPRSS SUBTRACTS A FXD CONSTANT FROM A VECTOR. 0018 
» 0019 
» THE CONSTANT MAY BE ONE OF THE VECTOR ELEMENTS. 0020 

* 0021 
» LANGUAGE - FAP SUBROUTINE ( FORTRAN— I I COMPATIBLE) 0022 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0023 

* STORAGE - 34 REGISTERS 0024 

* SPEED - BOOST - 36 ♦ 12.4»LX MACHINE CYCLES, LX*VECTOR LENGTH 0025 

* XBOOST - 38 + 8*LX 0026 
» DPRESS - 38 + 12.4*LX 0027 
» XDPRSS - 38 ♦ 8*LX 0028 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 0029 
« 0030 

* USAGE 0031 

* 0032 
» TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0033 
» AND FORTRAN SYSTEM ROUTINES - (NONE) 0034 

* 0035 
» FORTRAN USAGE 0036 
» CALL BOOST ( X, LX, XRUE,XBUSTD) 0037 
» CALL XBOOST ( IX, LIX, IXRIZE, IXBSTD) 0038 

* CALL DPRESS( X, LX, XSINK, XLWRO) 0039 
» CALL XDPRSS(IX,LIX,IXSINK,IXLWRD) 0040 

* 0041 

* INPUTS 0042 

* 0043 

* X(I) 1=1. ..LX IS A FLTG PT VECTOR 0044 

* 0045 

* LX SHOULD EXCEED 0 0046 

* 0047 
» XRIZE IS ANY FLTG VARIABLE. EQUIVALENCE (XRIZE, SOME XII)) OK. 0048 
» 0049 

* XSINK IS ANY FLTG VARIABLE. EQUIVALENCE (XSINK, SOME X(I)) OK. 0050 

* 0051 
» IX(I) 1=1.. .LIX IS A FXD PT VECTOR 0052 

* 0053 

* LIX SHOULD EXCEED 0 0054 
» 0055 

* IXRIZE IS ANY FXD VARIABLE. EQU I VALENCE ( IXRIZE, SOME IXU3) OK. 0056 

* 0057 

* IXSINK IS ANY FXD VARIABLE. EQUIVALENCE (IXSINK, SOME IX(D) OK. 0058 

* 0059 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUTS IF LX OR LIX LSTHN 1. 0060 

* 0061 
» XBUSTD(I) 1=1. ..LX HAS VALUES XBUSTD( I )=X( I )+XRIZE 0062 

* EQUIVALENCE (XBUSTD,X) IS PERMITTED. 0063 

* 0064 

* XLWRD(I) 1=1.. .LX HAS VALUES XLWRD( I )=X( I ) -XSINK 0065 

* EQUIVALENCE (XLWRO, X) IS PERMITTED. 0066 

* 0067 

* IXBSTD(I) 1=1.. .LIX HAS VALUES IXBSTD( I )=IX( I ) +IXRIZE 0068 
» EQUIVALENCE (IXBSTD, IX) IS PERMITTED. 0069 

* 0070 

* IXLWRD(I) 1=1.. .LIX HAS VALUES IXLWRD( I )=IX( I )-IXSINK 0071 

* EQUIVALENCE (IXLWRD,IX) IS PERMITTED. 0072 
» 0073 

* IF ANY OF THE ABOVE EQUIVALENCES OBTAIN, THE INITIAL 0074 



•»*•••»*••»••»•*•«••«•»« PROGRAM LISTINGS *#***»»»*#*•»»«♦*»*»»*** 

* BOOST « * BOOST » 

»«*«••#••»•••**»•#**•••* »«*»•*«**»»*•***•*•**••« 
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* VALUE OF THE QUANTITY IS ALWAYS USED AS THE ADDEND OR 0075 
» SUBTRAHEND. 0076 

* 0077 
» EXAMPLES 0078 

* 0079 

* 1. INPUTS - X(1...4)=l.,2.,3.,4. Yl I. . .4 ) = 1 . , 2. , 3. , 4. 0080 
» IX( 1...4)=1,2,3,4 IY(13*1 0081 
» W=WW=0.0 I W= I WW=0 0082 
» USAGE - CALL B00ST( X f 4, 2 • ,Z ) 0083 

* CALL DPRESS(Y,4 f 2.,U) 0084 

* CALL XBQOST( IX,4,2,IZ) 0085 

* CALL XDPRSSUY, 1,2, IU) 0086 

* CALL B00ST(X,0,2.,W) 0087 

* CALL DPRESS(Y,0,2.,WW) 0088 
» CALL XBOOST( IX,0,2,IW) 0089 

* CALL XDPRSS(IY,0,2, 1WW) 0090 

* 0091 

* OUTPUTS - Z<1...4)*3.,4.,5.,6. U ( I. . .4 ) 1. , 0. , 1 ♦ , 2* 0092 
» IZ(1..*4)=3,4,5,6 IU(l)=-l 0093 

* W=WW=0.0 IW=IWW=0 (NO OUTPUTS FROM LAST 4 CALLS) 0094 

* 0095 

* 2. INPUTS - SAME AS EXAMPLE I. 0096 

* USAGE - CALL BOOST ( X ,4, 2 . , X ) 0097 

* CALL DPRESS(Y,4, Y(3) ,Y) 0098 

* OUTPUTS - X ( I . . .4 )=3. ,4. , 5. , 6. Y( 1. ..4)=-2. ,-l.,0., 1. 0099 
» 0100 

* PROGRAM FOLLOWS BELOW 0101 

* 0102 
» NO TRANSFER VECTOR 0103 

HTR 0 XR4 0104 

BCI 1, BOOST 0105 

* PRINCIPAL ENTRY* 800ST( X,LX,XRIZE, XBUSTD) 0106 
BOOST CLA FAD 0107 
SETUP STO MODIFY 0108 

SXD BOOST-2,4 0109 

Kl CLA 1,4 0110 

ADD Kl A(X)+1 0111 

STA GET 0112 

CLA 4,4 0113 

ADD Kl A(XBUSTD)+1 0114 

STA STORE 0115 

CLA» 3,4 XRIZE 0116 

STO TEMP 0117 

* CHECK LX 0118 

CLA* 2,4 LX 0119 

TMI LEAVE 0120 

PDX 0,4 0121 

TXL LEAVE, 4,0 0122 

* LOOP 0123 
GET CLA **,4 *» 3 =A(X)+1 0124 

MODIFY NOP « FAD TEMP, ADD TEMP, FSB TEMP OR SUB TEMP 0125 

STORE STO **,4 *** A( XBUSTD ) + 1 0126 

TI.X GET, 4,1 0127 

* EXIT 0128 
LEAVE LXD BOOST-2,4 0129 

TRA 5,4 0130 

* SECOND ENTRY* XB00ST( IX.LIX, IXRIZE, IXBSTD) 0131 
XBOOST CLA ADD 0132 

TRA SETUP 0133 

» THIRD ENTRY. DPRESS (X,LX,XS INK,XLWRD) 0134 

DPRESS CLA FSB 0135 

TRA SETUP 0136 

* FOURTH ENTRY. XDPRSS( IX,LIX, IXSINK, IXLWRD) 0137 
XDPRSS CLA SUB 0138 

TRA SETUP 0139 

* CONSTANTS, VARIABLES. 0140 
ADD ADD TEMP 0141 
SUB SUB TEMP 0142 
FAD FAD TEMP 0143 
FSB FSB TEMP 0144 
TEMP PZE *«,♦*,** ADDEND OR SUBTRAHEND 0145 

END 0146 



*••••*»•**•*•*•*•*** PROGRAM LISTINGS #♦###*#**#**♦#»»**»*»*»* 

CALL * * CALL » 



»••••»•••******»•••«•*** 4* *-**#•*•*#»*#•*** ****** 

REFER TO REFER TO 

LOCATE LOCATE 



CALL2 



REFER TO 
LOCATE 



4«*** *»*••#***• •**••*••* 

* CALL2 * 
*•****•***«••#••»•**•»•• 

REFER TO 
LOCATE 



•*•«*•••••**•»»«•»•• PROGRAM LISTINGS #*»*#»»»**•*»#•*»»«»»*»• 

CARIGE * » CARIGE » 



♦ CARIGE {SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0097 

• LABEL 0001 
CCARIGE 0002 

SUBROUTINE CARI G£ (IT APE, NSPACE ) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - CARIGE 0007 

C SPACE CARRIAGE N LINES OR RESTORE PAGE 0008 

C 0009 

C CARIGE WRITES OUT CARRIAGE CONTROL HOLLERITH ON A GIVEN 0010 

C OUTPUT TAPE FOR OFF-LINE PRINTING UNDER PROGRAM CONTROL. 0011 

C IT WILL EITHER SPACE THE PRINTED PAGE N LINES (WHERE N 0012 

C MAY BE ZERO) OR GIVE A SINGLE PAGE RESTORE^ 0013 

C 0014 

C LANGUAGE - FORTRAN- I I SUBROUTINE 0015 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ♦ 1 TAPE UNIT) 0016 

C STORAGE - 47 REGISTERS 0017 

C SPEED - 0018 

C AUTHOR - S.M. SIMPSON, SEPTEMBER 1963 0019 

C 0020 

C USAGE 0021 

C 0022 

C TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0023 

C AND FORTRAN SYSTEM ROUTINES - (STH), (FID 0024 

C 0025 

C FORTRAN USAGE 0026 

C CALL CARIGE( ITAPE, NSPACE) 0027 

C 0028 

C INPUTS 0029 

C 0030 

C ITAPE IS A FORTRAN-I I INTEGER SPECIFYING THE LOGICAL TAPE TO 0031 

C BE USED. 0032 

C IS NOT EXAMINED FOR LEGALITY. 0033 

C 0034 

C NSPACE IS A FORTRAN-I I INTEGER SPECIFYING THE NUMBER OF SPACES 0035 

C (CARRIAGE RETURNS ) DESIRED. 0036 

C = + N PRODUCES N CARRIAGE RETURNS 0037 

C =-N PRODUCES 1 PAGE RESTORE 0038 

C =0 STRAIGHT RETURN WITH NO EFFECT 0039 

C 0040 

C OUTPUTS CARRIAGE CONTROL HOLLERITH IS WRITTEN OUT ON ITAPE. 0041 

C 0042 

C EXAMPLES 0043 

C 0044 

C 1. INPUTS - NSPACE(1...5)=1, 0,-5,4, 9 0045 

C 0046 

C USAGE - DO 5 1=1,5 0047 

C WRITE OUTPUT TAPE 2,10,1 0048 

C CALL CARIGE (2, NSPACE( I) ) 0049 

C 5 WRITE OUTPUT TAPE 2,10,1 0050 

C 10 FORMAT ( 17H THIS IS A MARKER, 6X,2HI = , 1 1) 0051 

C 0052 

C OUTPUTS - 2 PAGES OF PRINTED OUTPUT FROM LOGICAL UNIT 2, AS FOLLOWS 0053 

C 0054 

C PAGE 1 0055 

C 0056 

C (LINE 1) THIS IS A MARKER 1*1 0057 

C (BLANK LINE) 0058 

C THIS IS A MARKER 1=1 0059 

C THIS IS A MARKER 1=2 0060 

C THIS IS A MARKER 1=2 0061 

C (LINE 6) THIS IS A MARKER 1=3 0062 

C 0063 

C 0064 

C PAGE 2 0065 

C 0066 

C (LINE 1) THIS IS A MARKER 1=3 0067 

C THIS IS A MARKER 1=4 0068 

C (BLANK LINE) 0069 

C (BLANK LINE) 0070 

C (BLANK LINE) 0071 

C (BLANK LINE) 0072 

C THIS IS A MARKER 1=4 0073 

C THIS IS A MARKER 1=5 0074 



•»••***«**•*»•**••««««*» PROGRAM LISTINGS **#****#♦*♦*•#»*»#***»»♦ 

* CARIGE * * CARIGE » 

»*****»*»**«*«*»*»*****« ««**•******••»*»«*••«•** 
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c 


(BLANK LINE) 


0075 


c 


(BLANK LINE) 


0076 


c 


(BLANK LINE) 


0077 


c 


(BLANK LINE) 


0078 


c 


(BLANK LINE) 


0079 


c 


(BLANK LINE) 


0080 


c 


(BLANK LINE) 


0081 


c 


(BLANK LINE) 


0082 


c 


(BLANK LINE) 


0083 


C (LINE 18) THIS IS A MARKER 1=5 


0084 


C 




0085 


C 




0086 


C PROGRAM FOLLOWS BELOW 


0087 


C 




0088 




IF (NSPACE) 10,9999,30 


0089 


10 


WRITE OUTPUT TAPE ITAPE,20 


0090 


20 


FORMAT ( 1H1 ) 


0091 




GO TO 9999 


0092 


30 


DO 40 1=1 , NSPACE 


0093 


40 


WRITE OUTPUT TAPE ITAPE,50 


0094 


50 


FORMAT ( 1H ) 


0095 


9999 


RETURN 


0096 




END 


0097 



PROGRAM LISTINGS 



• CHISQR (SUBROUTINE) 9/29/64 CAST CARD IN DECK IS NO. 0084 

* LABEL 0001 
CCHISQR 0002 

SUBROUTINE CHISQR(NBL0CS, ICOUNT ,N,CHISQ, IANS) 0003 

C 0004 

C ——ABSTRACT 0005 

C 0006 

C TITLE - CHISQR 0007 

C COMPUTES CHI-SQUARE FOR EQUALLY LIKELY PROBABILITY CASE. 0008 

C 0009 

C CHISQR COMPUTES CHI SQUARE WHEN GIVEN THE DISTRIBUTION 0010 

C COUNT AND THE NUMBER OF EQUALLY LIKELY BLOCKS INTO WHICH 0011 

C THE DATA IS PUT. NUMBER OF BLOCKS = NBLOCKS, N * TOTAL 0012 

C NUMBER OF OBSERVATIONS, ICOUNT » DISTRIBUTION COUNT. 0013 

C 0014 

C CHISQ»SUM( (ICOUNTt I)-N/NBL0CKS)*»2/(N/NBL0CKS) ) 0015 

C 0016 
C SUMMED OVER NBLOCKS, WHERE FLOATING OPERATIONS ARE ASSUMED 0017 

C RATHER THAN THE INDICATED INTEGER OPERATIONS. 0018 

C 0019 

C LANGUAGE - FORTRAN II SUBROUTINE 0020 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0021 

C STORAGE - 105 REGISTERS 0022 

C SPEED - 0023 

C AUTHOR - J.N. GALBRAITH 0024 

C 0025 

C USAGE 0026 

C 0027 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0028 

C AND FORTRAN SYSTEM ROUTINES - NONE 0029 

C 0030 

C FORTRAN USAGE 0031 

C CALL CHISQRtNBLOCS, ICOUNT, N,CHISQ, IANS) 0032 

C 0033 

C INPUTS 0034 

C 0035 

C NBLOCKS IS NUMBER OF EQUALLY LIKELY BLOCKS. 0036 

C MUST BE GRTHN 1. 0037 

C 0038 
C ICOUNT(I) 1=1. ..NBLOCKS IS THE DISTRIBUTION COUNT. I.E. THE NUMBER 0039 

C OF VALUES IN I-TH EQUALLY LIKELY BLOCK. 0040 

C MUST BE NON-NEGATIVE 0041 

C 0042 

C N IS TOTAL NUMBER OF OBSERVATIONS ( =SUM< ICOUNT ( I) )) . 0043 

C MUST BE GRTHN= 1 • 0044 

C 0045 

C OUTPUTS 0046 

C 0047 

C CHISQ IS THE CHI-SQUARE VALUE 0048 

C 0049 

C IANS =0 NORMAL 0050 

C =1 ILLEGAL NBLOCS 0051 

C =2 ILLEGAL N 0052 

C 0053 

C EXAMPLES 0054 

C 0055 

C 1. INPUTS - NBL0CS*3 ICOUNT ( 1 . . . 3 1 , 3, 5 N*9 0056 

C OUTPUTS - CHI SQ=2. 666667 IANS^O 0057 

C 0058 

C 2. INPUTS - NBLOCS^l IC0UNT(1)=1 N*9 0059 

C OUTPUTS - ERROR IANS=1 0060 

C 0061 

C 3. INPUTS - NBL0CS=3 ICOUNT ( 1 . . . 3 ) *i , 3, 5 N=0 0062 

C OUTPUTS - ERROR IANS=2 0063 

C 0064 

C 4. INPUTS - NBL0CS*5 ICOUNT < 1. . . 5 1, 2, 3, 4, 5 N=15 0065 

C OUTPUTS - CHISQ=3. 333333 IANS=0 0066 

C 0067 

DIMENSION ICOUNT(IOO) 0068 

IANS=0 0069 

IF1NBL0CS-1) 990,990,5 0070 

5 IF(N) 992,992,10 0071 

10 P=i./FLOATF(NBLOCS) 0072 

EXPN0=P*FL0ATF(N) 0073 

CHISQ=0 0074 



•»***#*#•*»•••••»•**••»» PROGRAM LISTINGS *•»*••••»*•••«•*•*»•*••* 

* CHISQR * * CHISQR * 

**•****«**«**»**•*»*#•*» #*•#•»•*«•••*•*•*••*•••• 

(PAGE 2) (PAGE 2) 

DO 25 I=l,NBLOCS 0075 

DIF 3S FL0ATF( I COUNT ( I ) J-EXPNO 0076 

25 CHISQ*CHISQ+DIF«DIF 0077 
CHISQ=CHISQ/EXPNO 0078 

26 RETURN 0079 
990 IANS^l 0080 

GO TO 26 0081 

992 IANS=2 0082 

GO TO 26 0083 

END 0084 



»*•••••••••«•••••••»•••» PROGRAM LISTINGS *»•*»♦***»*»»#*»•»***»•« 

* CHOOSE » # CHOOSE • 



* CHOOSE < SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO. 0083 

* FAP 0001 
•CHOOSE 0002 

COUNT 100 0003 

LBL CHOOSE 0004 

ENTRY CHOOSE (ZIFRST, X,X1,X2, Y f Yl,Y2,.,.t Z,ZUZ2) 0005 

* 0006 
» 0007 

* ABSTRACT 0008 

* 0009 

* TITLE - CHOOSE 0010 

* SET A LIST OF VARIABLES TO ONE OF TWO SETS OF VALUES 0011 
» 0012 
» 0013 
» CHOOSE SETS A VARIABLE LENGTH LIST OF VARIABLES (X,Y,... t 0014 

* Z) FROM THE FIRST LIST <XI,Y1,«. .,Z1) OF A PAIR OF LISTS 0015 

* OF CONSTANTS IF ZIFRST=0. OR FROM THE SECONO LIST IF 0016 

* ZIFRST NOT=0. I.E., IF ZIFRST=0. CHOOSE SETS X=X1,Y«Y1, 0017 
» ...,Z=Zl. IF ZIFRST NOT'O. CHOOSE SETS X*X2, Y*Y2# .* k, , 0018 

* Z=Z2. 0019 

* 0020 
» 0021 

* LANGUAGE - FAP SUBROUTINE t FORTRAN II COMPATIBLE) 0022 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0023 

* STORAGE - 17 REGISTERS 0024 

* SPEED - 6 + 16»N MACHINE CYCLES, WHERE N * NO. OF SETTINGS 0025 
» AUTHOR - S.M. SIMPSON, APRIL 1964 0026 

* 0027 

* 0028 

* USAGE 0029 

* 0030 

* TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0031 
» AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0032 

* 0033 

* FORTRAN USAGE 0034 
» CALL CHOOSEUIFRST, X,Xl,X2, Y,Y1,Y2, Z,Zl,Z2) 0035 

* 0036 

* INPUTS 0037 

* 0038 

* ZIFRST * 0. IF VALUES X1,Y1,...,Z1 ARE TO BE CHOSEN. 0039 

* NOT* 0. IF VALUES X2,Y2,...,Z2 ARE TO BE CHOSEN. 0040 

* 0041 
» X1,X2,Y1,Y2,...,ZI,Z2, ARE ANY MODE 0042 
» 0043 

* 0044 

* OUTPUTS ILLEGAL RETURN OCCURS IF ARGUMENT COUNT IS NOT 0045 
» 1 ♦ MULTIPLE OF 3 . 0046 

* 0047 

* X,Y,...,Z ARE FORMED AS DESCRIBED IN ABSTRACT. 0048 
» 0049 

* 0050 
» EXAMPLES 0051 
» 0052 

* 1. USAGES - CALL CH00SE(-0. ,X1, 1. , 2. , 1X1,1,2) 0053 
» CALL CH00SEU,X2,1.,2.) 0054 
» CALL CH00SE<-.000l,X3» l.,2., 1X3,1,2, X4#X3*X3) 0055 
» OUTPUTS - Xi = l. 1X1=1 X2=2. X3=2. 1X3=2 X4=2. 0056 
» 0057 

* 0058 

* PROGRAM FOLLOWS BELOW 0059 

* 0060 

* NO TRANSFER VECTOR 0061 

* 0062 
BCI I, CHOOSE 0063 

* 0064 

* ONLY ENTRY. CHOOSE! Z IFRST, X,X1,X2, Y,Y1,Y2, ItZliZZ) 0065 

* 0066 
CHOOSE CLA K3 0067 

ZET* 1,4 0068 

ADD *-l 0069 

STA GET 0070 

CAL CAL 2,4 0071 

ANA AMASK 0072 

LAS TSXZ 0073 

TRA 2,4 0074 



*«•»*»*«*»*«**••***«*#»* PROGRAM 
• CHOOSE * 
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(PAGE 2) 



LI STINGS »»***»*♦##***##»»*«»#»»* 
* CHOOSE » 
#*««••*»»*»*••*•«•»*«*•» 

(PAGE 2) 





TRA 


GET 


0075 




TRA 


2,4 


0076 


GET 


CLA* 


*»,4 **=3 (ZIFRST=0), OR 4 (ZIERST NOT^O) 


0077 




STO* 


2,4 


0078 




TXI 


CAL,4,-3 


0079 


K3 


PZE 


3 


0080 


AMASK 


OCT 


777777700000 


0081 


TSXZ 


TSX 


0,0 


0082 




END 




0083 



»»*»»*«»*••••••**»»• PROGRAM LISTINGS #»***###*»*»»•**•*#«»*** 

CHPRTS * « CHPRTS * 

»••»*»•»•»»«»***»•»* #»»4ft**» •**«•*• •****»*•• 



* CHPRTS (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0148 

* FAP 0001 
♦CHPRTS 0002 

COUNT 150 0003 

LBL CHPRTS 0004 

ENTRY CHPRTS (SYM, ANT, N) 0005 

ENTRY RVPRTS (SYM, ANT, N) 0006 

» 0007 

« ABSTRACT 0008 

* 0009 

* TITLE - CHPRTS, WITH SECONDARY ENTRY RVPRTS 0010 

* FAST REVERSAL OF SPECIAL VECTORS (AS PRODUCED BY SPLIT) 0011 
» 0012 

* CHPRTS REVERSES THE STORAGE ORDER OF TWO VECTORS (CALLED 0013 

* ANT AND SYM) AND CHANGES THE SIGN OF ANT. 0014 

* 0015 
» RVPRTS REVERSES THE STORAGE ORDER OF TWO VECTORS. 0016 

* 0017 

* LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0018 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0019 

* STORAGE - 76 REGISTERS 0020 

* SPEED - ABOUT 6. 5*( COMBI NED LENGTH OF THE VECTORS) MACHINE CYCLES 0021 

* AUTHOR - S.M. SIMPSON JR 0022 
» 0023 

, USAGE 0024 

» 0025 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0026 
« AND FORTRAN SYSTEM ROUTINES - NONE 0027 
« 0028 

* FORTRAN USAGE 0029 

* CALL CHPRTS ( SYM, ANT, N) 0030 
« CALL RVPRTS (SYM, ANT, N) 0031 
» 0032 

* INPUTS 0033 

* 0034 

* SYM(I) 1*1. ..LS IS FIRST VECTOR TO BE REVERSED 0035 
» (NAME NEED NOT BE FLOATING POINT) 0036 

* 0037 

* ANT ( I ) 1 = 1. ..LA IS SECOND VECTOR TO BE REVERSED I AND SIGN 0038 
» CHANGED FOR CHPRTS ENTRY) 0039 

* (NAME NEED NOT BE FLOATING POINT) 0040 

* 0041 

* N = LS+LA 0042 
» IF N IS EVEN LS * LA = N/2 0043 

* IF N IS ODD LS * (N+D/2 LA * (N-l)/2 0044 

* IS FORTRAN II INTEGER 0045 

* 0046 

* OUTPUTS 0047 

* 0048 
» SYM(I) 1*1. ..LS IS THE REVERSED SYM SERIES. 0049 
» 0050 

* ANT ( I ) 1=1. ..LA IS THE REVERSED ANT SERIES (WITH SIGN CHANGED 0051 

* IF THE CHPRTS ENTRY WAS USED). 0052 
» ( NOTE- PROGRAM EXITS WITHOUT MODIFYING SYM OR ANT 0053 

* IF N IS LSTHN= 1) 0054 

* 0055 

* EXAMPLES 0056 
» 0057 

* 1. INPUTS - SYMU...3) * 3.,2.,1. ANTU...3) = 4.,1.,2. N=6 0058 

* OUTPUTS - CHPRTS SYMU...3) * l.,2.,3. ANTU...3) * -2.,-l.*~4. 0059 

* RVPRTS SYMU...3) * I. ,2. ,3. ANT(1...3) * 2.#i.,4. 0060 
» 0061 

* 2. INPUTS - SYM(1.*.3) = 3.,2.,1. ANT(l...2) = 4., 5. N=5 0062 

* OUTPUTS - CHPRTS SYMU...3) » l.,2.,3. ANTU...2) * -5. ,-4. 0063 
» RVPRTS SYMQ...3) = l.,2.,3. ANTQ...2) * 5. ,4. 0064 

* 0065 

* 3. INPUTS - SYM(l) = 1. ANT(1)=2. N=2 0066 

* OUTPUTS - CHPRTS SYM(1)=1. ANT(l)=-2. 0067 

* RVPRTS SYM(l)=i. ANT(1)=2. 0068 

* 0069 
PZE 0070 
BCI I, CHPRTS 0071 

CHPRTS CLA K3 0072 

STO CIO 0073 

CLA K4 0074 
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STO 


C12A 








0075 




TRA 


C2 








0076 


RVPRTS 


CLA 
STO 
CLA 
STO 


K5 

CIO 

K6 

C12A 








0077 
0078 
0079 
0080 


C2 


SXD 
SXA 
SXA 


CHPRTS 
LV+ltl 
LV+2»2 


~2t 


4 




0081 
0082 
0083 


* FIGURE THE 


LENGTHS 


OF 


SYM(LS) AND ANT(LA) 


0084 




CLA» 


3,4 






GET N 


0085 




ARS 


18 






IN ADDRESS 


0086 




CAS 


Kl 








0087 




TRA 


♦♦3 








0088 




TRA 


LV 




EXIT UNLESS 


0089 




TRA 


LV 




N 


EXCEEDS 1 


0090 




L8T 










0091 




TRA 


C3 






EVEN 


0092 




ARS 


I 






ODD LA*(N~l)/2=N/2 TRUNCATED 


0093 




STA 


LA 








0094 




AOO 


Kl 






LS=(N+1)/2=LA+1 


0095 




TRA 


C4 








0096 


C3 


ARS 
STA 


1 

LA 






EVEN LA=LS=N/2 


0097 
0098 


C4 


STA 


LS 








0099 


* SET 


DECREMENT AND ADDRESSES 


0100 




CLA 


LA 






DECR - LA/2 ROUNDED UP 


0101 




LRS 


I 








0102 




RND 










0103 




ALS 


18 








0104 




STD 


C18 








0105 




CLA 


It* 








0106 




ADD 


Kl 






SYM+i 


0107 




STA 


C14 








0108 




STA 


C17 








0109 




SUB 


LS 








0110 




SUB 


Kl 






SYM(LS)-1 


0111 




STA 


C15 








0112 




STA 


C16 








0113 




CLA 


2,4 








0114 




ADD 


Kl 






ANT+l 


0115 




STA 


CIO 








0116 




STA 


C13 








0117 




SUB 


LA 






ANT ( L A)~l 


0118 




SUB 


Kl 








0119 




STA 


Cll 








0120 




STA 


C12 








0121 




A XT 


1,1 






IR1 COUNTS UP FROM 1 TO LA/2 


0122 




AXT 


-1.2 






IR2 COUNTS DOWN FROM -1 TO -LA/2 


0123 


C 10 


NOP 








(»»=:ANT+1> REVERSE AND 


0124 


Cll 


LDQ 


«*,2 






(*»=ANT(LA)-1) POSSIBLY CHANGE 


0125 


C12 


STO 
XCA 


**,2 






(♦»=ANT(LA)-l) SIGN OF 

ANTISYMMETRIC 


0126 
0127 


C12A 


NOP 








PART 


0128 


C13 


STO 


**,1 






(*»=ANT*1) 


0129 


C14 


CLA 


**t I 






(#**SYM+1) REVERSES 


0130 


C15 


LDQ 


**,2 






(**=SYM(LS)-1) SYMMETRIC 


0131 


C16 


STO 


**,2 






(**=SYM(LS)-l> PART 


0132 


C17 


STQ 


**,! 






(*»=SYM+l) 


0133 




TXI 


*+i,2, 


-1 






0134 




TXI 


•♦It i. 


1 






0135 


C18 


TXL 


ClO.l, 


• • 




(*»=LA/2 ROUNDED UP) 


0136 


LV 


LXD 


CHPRTS 


-2,4 




0137 




AXT 


** v I 








0138 




AXT 


**, 2 








0139 




TRA 


4,4 








0140 


Kl 


PZE 


1 








0141 


LS 


PZE 


• » 






( **-LS=LENGTH OF SYM) 


0142 


LA 


PZE 


** 






(»*=LS=LENGTH OF ANT) 


0143 


K3 


CLS 


**t 1 






FOR CHPRTS 


0144 


K4 


CHS 








FOR CHPRTS 


0145 


K5 


CLA 


»*,1 






FOR PVPRTS 


0146 


K6 


NOP 

END 








FOR RVPRTS 


0147 
0148 



•****»••••******•»**••»» PROGRAM LISTINGS «•*#•*»••*••*••«•#»*#«•• 

• CHSIGN * * CHSIGN » 



•CHSIGN 



CHSIGN 
FAP 

N 

COUNT 

LBL 

ENTRY 



f SUBROUTINE ) 



100 

CHSIGN 

CHSIGN (X,LX,XNEG) 

ABSTRACT 



9/29/64 LAST CARD IN DECK IS NO* 



* TITLE - CHSIGN 

» CHANGE ALL SIGN BITS OF A VECTOR 

• 

* CHSIGN CHANGES SIGN BITS IN A FLOATING OR FIXED VECTOR 
• 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN-! I COMPATIBLE) 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 

* STORAGE - 18 REGISTERS 

* SPEED - 27 ♦ 6*LX MACHINE CYCLES, LX = VECTOR LENGTH 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 
» 

* USAGE 

• 

» TRANSFER VECTOR CONTAINS ROUTINES - ( NONE) 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 
» 

* FORTRAN USAGE 

* CALL CHSIGN(X,LX,XNEG) 



» INPUTS 

* XU ) 
* 

* LX 
* 

* OUTPUTS 

* XNEG(I) 
* 

» 

* EXAMPLES 
• 

* 1. INPUTS 

* USAGE 
• 

» 

* 

* OUTPUTS 



1=1. ..LX IS A FIXED OR FLOATING VECTOR 
SHOULD EXCEED 0 

STRAIGHT RETURN WITH NO OUTPUT IF LX LSTHN 1 
1=1. ..LX IS XNEG( I )= -X( I ) 
EQUIVALENCE <XNEG,X) IS PERMITTED. 



XU...4) = l.,-l.,2.,0. IX(1, 
CALL CHSIGN( X,4, XNEG) 
CALL CHSIGN( IX, 4, IXNEG) 
CALL CHSIGN( X,4, X) 
CALL CHSIGN( IX, 1, IX) 
CALL CHSIGN( X,0, Y) 

XNEGU...4) = -l.,l.,-2.,-0. 
XU...4) » -l.,l.,-2.,-0. 

Y * 0.0 (NO OUTPUT CASE) 



.4) 



-1,1,-2,-0 Y«0. 



IXNEGU...4) « 1,-1,2,0 
IX(1) = 1 



PROGRAM FOLLOWS BELOW 



* NO TRANSFER VECTOR 



0077 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
002 3 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 





HTR 


0 


XR4 


0056 




BCI 


1, CHSIGN 




0057 


* ONLY 


ENTRY. 


CHSIGNfX,LX 


f XNEG ) 


0058 


CHSIGN 


SXD 


CHSIGN-2,4 




0059 


Kl 


CLA 


1,4 




0060 




ADD 


Kl 


A(X)+1 


0061 




STA 


GET 




0062 




CLA 


3,4 




0063 




ADD 


Kl 


A( XNEG)+1 


0064 




STA 


STORE 




0065 




CLA» 


2,4 


LX 


0066 




TMI 


LEAVE 




006 7 




PDX 


0,4 




0068 




TXL 


LEAVE, 4,0 




0069 


♦ REVERSING LOOP 




0070 


GET 


CLS 


• *,4 


**=A(X)+l 


0071 


STORE 


STO 


»*,4 


***A(XNEG)+1 


0072 




TIX 


GET, 4,1 




0073 



• EXIT 



0074 
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LEAVE LXO CHSIGN-2,4 
TRA 4,4 

END 



* CHSIGN • 
#*#*•»«»*♦#*»***»»**»•»♦ 

(PAGE 2) 

0075 
0076 
0077 
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*»•*«•»»••*•*»*••***•«*» *»*•»*«**•*•*#«*****»»»* 

REFER TO REFER TO 

INDEX INDEX 
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» CLKON (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0041 

♦ LABEL 0001 

CCLKON 0002 

SUBROUTINE CLKON 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - CLKON 0007 

C CHECKS IF INTERVAL TIMER IS ON 0008 

C 0009 

C CLKON OPERATES CL0CK1 TO DETERMINE IF THE INTERVAL TIMER 0010 
C IS ON. IF IT IS NOT ON, CLKON PRINTS AN ON-LINE MESSAGE 0011 

C 0012 

C OPERATOR* PLEASE TURN INTERVAL TIMER ON 0013 

C 0014 

C REPEATEDLY UNTIL THE TIMER IS TURNED ON. IF THE TIMER 0015 

C IS ON, CLKON RETURNS TO THE CALLER. 0016 

C 0017 

C LANGUAGE - FORTRAN II SUBROUTINE 0018 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME, INTERVAL T IMER, AND ON-LINE 0019 

C PRINTER) 0020 

C STORAGE - 46 REGISTERS 0021 

C AUTHOR - R.A. WIGGINS MAY , 1963 0022 

C 0023 

C USAGE 0024 

C 0025 

C TRANSFER VECTOR CONTAINS ROUTINES - CL0CK1 0026 

C AND FORTRAN SYSTEM ROUTINES - (FIL),(SPH) 0027 

C 0028 

C FORTRAN USAGE 0029 

C CALL CLKON 0030 

C 0031 

C PROGRAM FOLLOWS BELOW 0032 

C 0033 

10 JOB=0 0034 

CALL CL0CK1 <JOB,TIME) 0035 

IF < JOB) 20,40,40 0036 

20 PRINT 30 0037 

30 FORMAT ( 1H05X39H0PERAT0R, PLEASE TURN INTERVAL TIMER ON) 0038 

GO TO 10 0039 

40 RETURN 0040 

END 0041 



• CL0CK1 (7090) * 
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PROGRAM LISTINGS 



• CLOCKl (7090) » 



« CLOCKl (7090) (SUBROUTINE) 3/15/65 LAST CARD IN DECK IS NO. 0147 

* FAP 0001 
•CLOCKl (7090) 0002 

COUNT 130 0003 

LBL CLOCKl 0004 

ENTRY CLOCKl (JOB, TIME) 0005 

« 0006 

« -ABSTRACT 0007 

» 0008 

« TITLE - CLOCKl 0009 

« FOR REAL TIME TIMING IN SECONDS USING 7090 INTERVAL CLOCK 0010 

* 0011 
« CLOCKl ALLOWS FORTRAN ACCESS TO THE CORE STORAGE CLOCK 0012 
» SO THAT IT MAY BE USED AS A TIMER. IT WILL RETURN THE 0013 

* ELAPSED TIME IN SECONDS AS A FLOATING POINT NUMBER OR IN 0014 

* FIXED POINT MULTIPLES OF 1/60 SECOND. 0015 

* 0016 
« CLOCKl WILL ALSO TELL IF THE INTERVAL CLOCK IS RUNNING 0017 

* 0018 
« LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0019 
« EQUIPMENT - 7090, 7094 (MAIN FRAME, CORE STORAGE CLOCK 0020 
» AND INTERVAL TIMER) 0021 
« STORAGE - 57 REGISTERS 0022 

* AUTHOR - S.M. SIMPSON, MAY, 1962 0023 

* 0024 
» USAGE 0025 

* 0026 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0027 

* AND FORTRAN SYSTEM ROUTINES - NONE 0028 
« 0029 
« FORTRAN USAGE 0030 
« CALL CLOCK1(JOB,TIME) 0031 
» 0032 
» INPUTS 0033 
« 0034 

* JOB DEFINES WHAT CLOCKl DOES. 0035 
« =0 CHECKS TO SEE IF CLOCK IS RUNNING. 0036 
« =1 REMEMBERS PRESENT CORE STORAGE CLOCK VALUE. 0037 

* *2 TELLS ELAPSED TIME FROM LAST TIME J0B*1 0038 

* (IN SECONDS, FLOATING POINT). 0039 

* =3 TELLS ELAPSED TIME FROM LAST TIME J0B=1 0040 
» (IN FORTRAN II INTEGER MULTIPLES OF 1/60 SECOND). 0041 
» IS FORTRAN II INTEGER. 0042 

* 0043 
« OUTPUTS 0044 
« 0045 

* JOB IS UNDISTURBED EXCEPT FOR THE CASE OF INPUT JOB-0 AND 0046 
« THE CORE STORAGE CLOCK (REGISTER 5) IS NOT RUNNING. 0047 
« IN THIS CASE JOB IS SET « -1. 0048 

* 0049 

* TIME IF INPUT JOB * 0 IS UNDISTURBED. 0050 

* = 1 IS UNDISTURBED. 0051 
« * 2 IS SET = NO. SECONDS (IN FLOATING POINT) 0052 

* WHICH HAVE ELAPSED SINCE THE LAST USE 0053 
» WITH JOB = 1. 0054 

* 58 3 IS SET s NO. OF COUNTS (IN FORTRAN II 0055 

* INTEGERS) (1 COUNT * 1/60 SEC) 0056 
» MODULO 2»*17 . 0057 
« MAY DIFFER ON SUCCESSIVE RUNS BY .016667 SEC. 0058 
« 0059 

* EXAMPLES 0060 
» 0061 
« 1. INPUTS - ASSUME THE FOLLOWING USE OF CLOCKl 0062 

* 10 CALL CL0CKKJ0B1, TIMED 0063 

* 20 DO 30 1*1,32765 0064 

* 30 CONTINUE 0065 
« 40 CALL CLOCKK JOB2,TIME2) 0066 

* J081=0 J0B2=2 CLOCK IS NOT ON. 0067 
» 0068 

* OUTPUTS - J0B1*-1 TIME1 IS UNDISTURBED TIME2 CONTAINS A 0069 
« MEANINGLESS NUMBER. 0070 
« 0071 
« 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT CLOCK IS ON. 0072 

* OUTPUTS - JOBl^O TIME1 IS UNDISTURBED TIME2 CONTAINS A 0073 
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« MEANINGLESS NUMBER 0074 

* 0075 

* 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT CLOCK IS ON J0B1=1 J0B2*2 0076 

* OUTPUTS - J0B1*1 TIME1 UNDISTURBED J0B2=2 TIME2* .28 (7090) 0077 

* OR .13 (7094) 0078 
« 0079 

* 4. INPUTS - SAME AS EXAMPLE 1. EXCEPT CLOCK IS ON J0B1=1 JOB2=3 0080 
» OUTPUTS - JOBl*l TIME1 UNDISTURBED JOB2=3 TIME = 17 (7090) 0081 

* OR 8 (7094) 0082 

* 0083 
HTR 0 0084 
BCI 1,CL0CK1 0085 

CL0CK1 SXD CLOCKl-2,4 0086 

CLA 5 0087 

STO TEMP 0088 

SXA LV,1 0089 

CLA 1,4 0090 

STA SJ1 0091 

STA SJ2 0092 

CLA 2,4 0093 

STA STORE 0094 

•FIND OUT WHICH JOB 0095 

SJ1 CLA »* •♦=JOB 0096 

TMI LV 0097 

CAS KD1 0098 

TRA J20R3 0099 

TRA J0B1 0100 

TRA JOBZ 0101 

J20R3 SUB KD1 0102 

CAS KD1 0103 

TRA J0B3 0104 

TRA J0B2 0105 

TRA LV 0106 

* WAIT A SECOND (IN THE 709) 0107 
JOBZ LXA K32K,1 0108 

LOOP TIX LOOP, 1,1 0109 

•DID CLOCK INCREMENT (YES IF NOW DIFFERENT FROM TEMP) 0110 

CLA 5 0111 

CAS TEMP 0112 

TRA LV 0113 

TRA NOCLOK 0114 

TRA LV 0115 

♦INDICATE CLOCK NOT RUNNING 0116 

NOCLOK CLS KD1 0117 

SJ2 STO *» «»=JOB 0118 

TRA LV 0119 

•FOR JOB 1 SAVE REG 5 AND EXIT 0120 

J0B1 CLA 5 0121 

STO ORG 0122 

TRA LV 0123 

•FOR JOB 2 OR 3 SET DIFFERENCE 0124 

J0B3 CLA TEMP 0125 

SUB ORG 0126 

ANA KMSK 0127 

ALS 18 0128 

TRA STORE 0129 

J0B2 CLA TEMP 0130 

SUB ORG 0131 

ORA KOCT 0132 

FAD KOCT 0133 

FDP KCONV 0134 

STQ TEMP 0135 

CLA TEMP 0136 

STORE STO •* **=TIME 0137 

LV AXT ♦*,! ••= XR1 0138 

TRA 3,4 0139 

KD1 PZE 0,0,1 0140 

KOCT OCT 233000000000 0141 

KMSK OCT 000000377777 0142 

K32K PZE 32767 0143 

KCONV DEC 60.0 0144 

TEMP PZE ♦* ♦» = TEMPORARY 0145 

ORG PZE ♦* »»«CLOCK SAVE 0146 

END 0147 
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* CMPARP » 



« CMPARP ( SUBROUTINE ) 9/29/64 LAST CARD IN DECK IS NO. 0150 

« FAP 0001 

♦CMPARP 0002 

COUNT 150 0003 

LBL CMPARP 0004 

ENTRY CMPARP ( I ANS, XI, Yl ,X2, Y2, . . . ,XN, YN) 0005 

ENTRY CMPARS ( I ANSt XI , X2 , • . . , XN ) 0006 

* 0007 

* ABSTRACT 0008 

* 0009 

* TITLE - CMPARP WITH SECONDARY ENTRY CMPARS 0010 

* COMPARE PAIRS OF VARIABLES OR A SET OF VARIABLES FOR EQUALITY 0011 

* 0012 

* CMPARP IS A VARIABLE-LENGTH-CALLING-SEQUENCE SUBROUTINE 0013 
« WHICH TREATS ITS ARGUMENTS, BEYOND THE FIRST ONE, IN 0014 

* PAIRS. THE TWO ELEMENTS IN EACH PAIR ARE COMPARED FOR 0015 

* IDENTITY. 0016 
« 0017 

* CMPARS IS A VARIABLE-LENGTH-CALLING-SEQUENCE SUBROUTINE 0018 

* WHICH TREATS ITS ARGUMENTS, BEYOND THE FIRST ONE, AS A 0019 

* SET OF QUANTITIES. THE ELEMENTS IN THIS SET ARE 0020 
« COMPARED TO SEE IF THEY ARE ALL IDENTICAL. 0021 
» 0022 

* BOTH ENTRIES CONSIDER +0 TO BE THE SAME AS -0 AND LEAVE 0023 

* THE RESULT OF THE TEST IN THEIR FIRST ARGUMENT. 0024 

* 0025 
« LANGUAGE - FAP SUBROUTINES (FORTRAN- I I COMPATIBLE) 0026 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0027 

* STORAGE - 53 REGISTERS 0028 

* SPEEO - 0029 

* AUTHOR - S.M. SIMPSON JR., OCTOBER 1963 0030 
« 0031 

* USAGE 0032 

« 0033 

« TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0034 

* ANO FORTRAN SYSTEM ROUTINES - (NONE) 0035 

* 0036 

* FORTRAN USAGE OF CMPARP 0037 

* CALL CMPARP(IANS,Xi,Yl,X2,Y2,...,XN,YN) 0038 

* 0039 

* INPUTS 0040 

* 0041 

* XI, Yl IS FIRST PAIR TO BE TESTED, ANY MODE 0042 
» X2,Y2 IS SECOND PAIR TO BE TESTED, ANY MODE 0043 

* ETC 0044 
» XN, YN IS N-TH PAIR TO BE TESTED, WHERE N MUST EXCEED 0 . 0045 

* 0046 

* OUTPUTS ILLEGAL RETURN RESULTS IF ARGUMENT COUNT IS EVEN OR LESS 0047 
« THAN 3 . 0048 

* 0049 
« IANS *0 IF X1=Y1 AND X2*Y2 AND.. .AND XN=YN (+0=-0) 0050 

* *K IF XK NOT= YK (K IS LOWEST SUCH INDEX IF MORE THAN 0051 

* ONE) 0052 

* 0053 

* FORTRAN USAGE OF CMPARS 0054 

* CALL CMPARS(IANS,Xl,X2,...,XN) 0055 
« 0056 

* INPUTS 0057 

* 0058 

* X1,X2,...,XN ARE THE N QUANTITIES (ARBITRARY MODE) TO BE TESTED. 0059 

* N MUST BE GRTHN=2 . 0060 
« 0061 
» OUTPUTS AN ILLEGAL RETURN RESULTS IF ARGUMENT COUNT IS LESS 0062 

* THAN 3 . 0063 

* 0064 

* IANS =0 IF X1»X2«...*XN (+0 EQUALS -0 IN THE TEST) 0065 

* =K IF XK NOT* XK+1 (K IS THE LOWEST SUCH INDEX) 0066 
« 0067 

* 0068 

* EXAMPLES 0069 

* 0070 
« 1. INPUTS - A1,A2,A3 * l.,2.,3. B1,B2,B3 = l.,2.,3. 1X1 = IY1 = 1 0071 

* AZ = 0. BZ » -0. C3 = D3 = 3. 0072 

* 0073 

* USAGE - CALL CMPARPt I ANSI , AZ ,8Z , Al , Bl , A2 , B2 , A3, B3, I XI, I Yl ) 0074 
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» CALL CMPARP(IANS2,A1,B1,IX1, IY1, Al, AZ,A3,B2> 0075 

» CALL CMPARS( I ANS3, A3, B3,C3, 03} 0076 

» CALL CMPARS( IANS4^ A3,B3,B2,D3) 0077 

» 0078 

» OUTPUTS - IANS1 * 0 I ANS2 * 3 IANS3 » 0 IANS4 » 2 0079 

» 0080 

« PROGRAM FOLLOWS BELOW 0081 

* 0082 

* 0083 

* NO TRANSFER VECTOR 0084 

HTR 0 XRl 0085 

HTR 0 XR2 0086 

HTR 0 XR4 0087 

* PRINCIPAL ENTRY. CMPARP ( I ANS, XI, Yl ,X2 , Y2, . . • , XN, YN ) 0088 

BCI 1, CMPARP 0089 

CMPARP CLA K0M2 0090 

TRA SETUP 0091 

* SECONDARY ENTRY. CMPARS ( I ANS , XI , X2 , . . . ,XN ) 0092 

BCI 1, CMPARS 0093 

CMPARS CLA KDM1 0094 

SETUP STD TXI2 0095 

STA EXIT 0096 

STA CALX 0097 

SXD CMPARP-2,4 0098 

SXD CMPARP-3,2 0099 

SXD CMPARP-4,1 0100 

CLA 1,4 A(IANS) 0101 

STA STOANS 0102 

» POSITION 1,4 TO XI AND CLEAR XRl 0103 

TXI »+l,4,-l 0104 

LXA AMASK, 1 0105 

» LOOP TO MOVE ALONG ARGUMENTS 1 OR 2 AT A TIME 0106 

TXI1 TXI *+l,l,l XRl COUNTS COMPARISONS 0107 

CAL 2,4 TSX Y1,0 TSX Y2,0 ... 0108 

TSX TSX2CK,2 0109 

TRA PXDZ RUN OFF 0110 

CAL 1,4 MAYBE OK 0111 

TSX TSXZCK,2 0112 

TRA PXDZ RUN OFF 0113 

TRA ISARG NEW PAIR 0114 

* SET IANS=0 IF RUN OFF ARGUMENTS, AND LEAVE 0115 
PXDZ PXD 0,0 0116 

» EXIT 0117 

STOANS STO ** *» * A(IANS) 0118 

LXD CMPARP-3,2 0119 

LXD CMPARP-4,1 0120 

EXIT TRA »*,4 *» * 1 (CMPARP ) OR 2(CMPARS» 0121 

* FOR MORE ARGUMENTS MAKE COMPARISON 0122 
ISARG CLA» 1,4 X1,X2,... (EITHER ENTRY) 0123 

TNZ CAS 0124 

NZT* 2,4 SPECIAL TREATMENT 0125 

TRA TXI2 FOR FIRST MAGNITUDE ZERO 0126 

CAS CAS» 2,4 Y2,Y3,... OR X2,X3,... 0127 

TRA »+2 0128 

TXI2 TXI TXI1,4,«* *» * -2 OR -1 0129 

* COMPARISON FAILS, RUN TO END OF ARGUMENTS, SET IANS, EXIT 0130 
CALX CAL **,4 »» = 1 (CMPARP ) OR 2(CMPARS) 0131 

TSX TSXZCK,2 0132 

TRA »+2 END 0133 

TXI CALX, 4,-1 MORE 0134 

PXD 0,1 END 0135 

TRA STOANS 0136 

* INTERNAL SUBROUTINE TO CHECK IF AC = TSX X,0 0137 
» LINKAGE XR2 0138 
» RETURNS TO 1,2 IF NOT, TO 2,2 IF SO 0139 
TSXZCK ANA AMASK 0140 

LAS TSXZ 0141 

TRA *+2 0142 

TRA 2,2 YES 0143 

TRA 1,2 NO 0144 

* CONSTANTS, VARIABLES 0145 
AMASK OCT 777777700000 0146 
TSXZ TSX 0,0 0147 
KDM1 PZE 2,0,-1 0148 
KDM2 PZE 1,0,-2 0149 

END 0150 
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» CMPARV (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO. 0155 

* FAP 0001 
•CMPARV 0002 

COUNT 200 0003 

LBL CMPARV 0004 

ENTRY CMPARV ( Vlt V2,LV, IANS ) 0005 

ENTRY CMPARL ( VI, V2,LV, IANS ) 0006 

* 0007 

* 0008 

» ABSTRACT 0009 

» 0010 

* TITLE - CMPARV WITH SECONDARY ENTRY CMPARL 0011 

* FAST COMPARE TWO ARBITRARY MODE VECTORS FOR IDENTITY 0012 

* 0013 

* CMPARL COMPARES TWO VECTORS, VHI) AND V2U) 1 = 1*. *LV, 0014 

* ELEMENT BY ELEMENT (36 BIT COMPARISON) CHECKING FOR 0015 

* IDENTITY. IT EITHER CONFIRMS THAT THE TWO VECTORS ARE 0016 
» IDENTICAL ORt IF THEY ARE NOT, IT RETURNS THE FIRST INDEX 0017 

* FOR WHICH THE ELEMENTS WERE FOUND TO DIFFER. 0018 

* 0019 
» CMPARV IS IDENTICAL TO CMPARL EXCEPT THAT IT CONSIDERS 0020 
» +0 TO BE THE SAME AS -0 . 0021 
» 0022 

* LANGUAGE - FAP SUBROUTINES, FORTRAN II COMPATIBLE 0023 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0024 

* STORAGE - 50 REGISTERS 0025 

* SPEED - (FOR CASES WHERE THE VECTORS MATCH. LESS OTHERWISE*) 0026 
» 62 + 6*LV MACHINE CYCLES IF LV EXCEEDS 1 0027 
» 48 MACHINE CYCLES IF LV = 1 0028 
» AUTHOR - S.M. SIMPSON* JULY 1963 0029 

* 0030 
» 0031 

* USAGE 0032 

* 0033 

* TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0034 

* AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0035 

* 0036 
» FORTRAN USAGE 0037 
« CALL CMPARV(V1,V2,LV,IANS) 0038 

* CALL CMPARL(Vl,V2,LV,IANS) 0039 

* 0040 

* INPUTS 0041 

* 0042 
» Vl(I) I-1...LV IS FIRST VECTOR (ANY KIND OF MODE) 0043 

* 0044 

* V2(I) 1=1. ..LV IS SECOND VECTOR (ANY KIND OF MODE) 0045 

* 0046 

* LV MUST EXCEED ZERO 0047 

* 0048 
» OUTPUTS 0049 

* 0050 
» IANS = +1 MEANS VECTORS IDENTICAL 0051 
» =0 MEANS LV IS ILLEGAL, NO COMPARISONS MADE 0052 

* » -K MEANS ELEMENTS NO. K WERE THE FIRST ELEMENTS 0053 
» FOUND TO DISAGREE. THE ORDER IN WHICH THE ELEMENTS 0054 
» ARE COMPARED IS ACCORDING TO THE INDEX ORDER - 0055 

* 1, LV, LV-1, 2 0056 

* 0057 
» 0058 
» EXAMPLES 0059 

* 0060 
» 1. MISC. CASES OF FLOATING AND FIXED VECTORS 0061 

* INPUTS - VK1...5) = l.,2.,3.,4.,5. IVK1...5) = 1,2,3,4,5 0062 

* V2U...5) = l.,2.,2.,5.,5. IV2U...5) = 2,2,3,5,5 0063 
» Xl= OCTOOOOOOOOOOOO X2= OCT400000000000 0064 

* USAGE - CALL CMPARV ( V 1 , V2, 2, IANS 1 ) 0065 

* CALL CMPARL( V1,V2,2, JANS1) 0066 

* CALL CMPARVt IV1, IV1, 5, I ANS2) 0067 
» CALL CMPARL ( I VI, IV1, 5, JANS2) 0068 

* CALL CMPARV ( VI, V 2, 5, IANS 3) 0069 
» CALL CMPARL (VI, V2, 5, J AN S3) 0070 

* CALL CMPARV( I VI, I V2, 5, I ANS4) 0071 

* CALL CMPARL( IV1, IV2, 5, JANS4) 0072 

* CALL CMPARV(X1,X2, 1, IANS5) 0073 

* CALL CMPARL(X1,X2,1,JANS5) 0074 
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* CALL CMPARV! VI, V2,0,IANS6) 0075 

* OUTPUTS - IANS1=1ANS2*JANS1=JANS2=*1 0076 

* IANS3=JANS3 « -4 (4TH ELEMENT IS FIRST MISMATCH FOUND) 0077 

* IANS4*JANS4 » -1 (1ST ELEMENT IS FIRST MISMATCH FOUND) 0078 

* IANS5=*i (OOESN'T DISTINGUISH +0 AND -0 0079 
« JANS5 = -1 (DISTINGUISHES +0 AND -0) 0080 
« IANS6 = 0 (ILLEGAL LV) 0081 
» 0082 
» 0083 
« PROGRAM FOLLOWS BELOW 0084 
» 0085 

HTR 0 XR1 0086 

HTR 0 XR4 0087 

BCI 1, CMPARV 0088 

* PRINCIPAL ENTRY. CMPARV ( VI , V2, LV, IANS ) 0089 
CMPARV STZ ZIFCV 0090 

TRA SETUP 0091 

* SECOND ENTRY. CMPARL( VI, V2,LV, IANS) 0092 
CMPARL SXD ZIFCV, 4 0093 

SETUP SXD CMPARV-2,4 0094 

SXD CMPARV-3,1 0095 

« CHECK LV 0096 

STZ IANS 0097 

CLA* 3,4 LV 0098 

TMI LEAVE 0099 

« SET LOOP INDEX REGISTER WITH LV 0100 

PDX 0,1 0101 

TXL LEAVE, 1,0 0102 

* FIRST COMPARE Vl(l) WITH V2(l) SINCE COMPARE LOOP DOESNT DISTINGUISH 0103 

* 1. ALL ELEMENTS MATCHING 0104 

* FROM 0105 

* 2. ALL ELEMENTS BUT FIRST MATCHING 0106 

CLA KOI 0107 

STO IANS 0108 

CLA* 1,4 0109 

CAS* 2,4 0110 

TRA DIFF NO 0111 

TRA N010K YES 0112 

« DISREGARD ZERO MISMATCH FOR CMPARV 0113 

DIFF NZT ZIFCV NO 0114 

TZE N010K 0115 

TRA LEAVE 0116 

* THEN EXIT IF LV=1 0117 
NOIOK CLS KD1 0118 

STO IANS 0119 

TXL LEAVE, 1,1 0120 

* OTHERWISE SET ADDRESSES AND ENTER LOOP 0121 

CLA 1,4 A(V1) 0122 

ADD Kl 0123 

STA CLA 0124 

CLA 2,4 A(V2) 0125 

ADD Kl 0126 

STA CAS 0127 

« COMPARE LOOP (6 CYCLES PER CHECK) 0128 

CLA CLA **,1 **=A(V1)+1 0129 

CAS CAS **,1 **=A(V2)+1 0130 

TRA *+2 MISMATCH 0131 

TIX TIX CLA, 1,1 MATCH 0132 

* .WHEN IT GETS HERE IT EITHER FELL THRU LOOP (OK) 0133 
» OR JUMPED OUT (MISMATCH). WE HAVE TO CHECK WHICH. 0134 

TXL LEAVE, 1,1 (XR1*1 I.F.F. FELL THRU) 0135 

* JUMPED OUT. WE MUST DISREGARD MISMATCH FOR 0136 
» THE ENTRY CMPARV IF THE MAGNITUDES ARE ZERO. 0137 

ZET ZIFCV 0138 

TRA PXD 0139 

NZT* CAS 0140 

TZE TIX 0141 

* OTHERWISE SET IANS 0142 
PXD PXD 0,1 0143 

STO IANS 0144 

* EXIT, SETTING IANS 0145 
LEAVE CLS IANS 0146 

STO* 4,4 0147 

LXD CMPARV-3,1 0148 

TRA 5,4 0149 
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* VARIABLES, CONSTANTS 0150 

ZIFCV PZE 0,0,** «*=0 IF CMPARV, NOT = 0 IF CMPARL 0151 

IANS PZE 0,0,** 0152 

KOI PZE 0,0,1 0153 

Kl PZE 1 0154 

ENO 0155 
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* CMPRA * « CMPRA 



» 


CMPRA 


(FUNCTION) 


9/4/64 


LAST CARD IN DECK IS NO. 0103 


• 


FAP 






0001 


♦CMPRA 








0002 




COUNT 


100 




0003 




LBL 


CMPRA 




0004 




ENTRY 


CMPRA F(X1,X2) 




0005 




ENTRY 


XCMPRA F(X1,X2) 




0006 




ENTRY 


CMPRFL F(X1,X2) 




0007 


• 








0008 


• 








0009 


• 




ABSTRACT 




0010 



» TITLE - CMPRA WITH SECONDARY ENTRIES XCMPRA AND CMPRFL, 

* COMPARE ARITHMETICALLY TWO WORDS, -0 LSTHN +0 . 
* 

* CMPRA COMPARES TWO WORDS XI AND X2 TO SEE IF XI IS LSTHN, 
» EQUAL TO, OR GRTHN X2. -0 IS CONSIDERED LSTHN +0 . 

• 

» XCMPRA IS IDENTICAL TO CMPRA. 
♦ 

» CMPRFL COMPARES THE CHARACTERISTIC AND 22 MOST 

* SIGNIFICANT BINARY DIGITS OF TWO FLOATING POINT NUMBERS. 



* LANGUAGE - FAP FUNCTIONS, FORTRAN- 1 1 COMPATIBLE 

* EQUIPMENT - 709 OR 7090 {MAIN FRAME ONLY) 
» STORAGE - 18 REGISTERS 

* SPEED - 16 OR 26 MACHINE CYCLES ON 7090. 
» AUTHOR - R.A. WIGGINS, 11/63 



* USAGE 

» 

* TRANSFER VECTOR CONTAINS ROUTINES 

* AND FORTRAN SYSTEM ROUTINES 
* 

* FORTRAN USAGE 

* X » CMPRA F(X1,X2) 
« JX * XCMPRAF(X1,X2) 
» FL * CMPRFLF(X1,X2) 



NONE 
NONE 



INPUTS 
XI 
X2 

OUTPUTS 
X 

JX 
FL 



• EXAMPLES 



♦ 1. INPUTS 

* USAGE 



IS A WORD IN ANY MODE. 
IS A WORD IN ANY MODE. 



-1 (FIXED POINT) IF XI LSTHN X2. 

0 IF XI = X2. 

+1 (FIXED POINT) IF XI GRTHN X2. 



(-0 LSTHN +0) 



-1 IF XI LSTHN X2. 

0 IF XI » X2. 
+1 IF XI GRTHN X2. 



(-0 LSTHN +0) 



OUTPUTS 



» 2. INPUTS 
• USAGE 



-1 (FIXED POINT) IF TX1 LSTHN TX2. (-0 LSTHN 4-01. 

0 IF TX1 * TX2. 

♦1 (FIXED POINT) IF TX1 GRTHN TX2. 

WHERE TXl AND TX2 REPRESENT THE CHARACTERISTIC AND 
MOST SIGNIFICANT 22 BINARY DIGITS OF XI AND X2. 



XI * 6HABCDEF X2 « 6HABCDEF 
X * CMPRAF(X1,X2) 
JX=XCMPRAF(X1,X2) 

X * 0, JX = 0 

XI s 1.2345678 X2 * 1.2345679 

X = CMPRFLF(X1,X2) 



0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
002 3 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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L I STINGS ##»*******♦#»##♦##♦#»#•# 
* CMPRA » 
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* OUTPUTS 


- X * 0 


0075 


» 






0076 


• 3. INPUTS 


- XI » 0. X2 = -0. 


0077 


» USAGE 


X » CMPRAF(X1,X2) 


0078 


* OUTPUTS 


- X = «•! 


0079 


• 






0080 


# 






0081 


* PROGRAM FOLLOWS BELOW 


0082 


• 






0083 


• 






0084 




BCI 


1* CMPRA 


0085 


XCMPRA 


BSS 


0 


0086 


CMPRA 


SXA 


LV,4 


0087 




AXT 


0,4 


0088 




STQ 


TEMP 


0089 




CAS 


TEMP 


0090 




TXI 


♦♦1,4,1 


0091 




TXI 


•+lt«t 1 


0092 




PXD 


*4 


0093 




SUB 


= 1817 


0094 


LV 


AXT 


• * f 4 


0095 




TRA 


It* 


0096 


CMPRFL 


ARS 


6 


0097 




ALS 


6 


0098 




LGR 


6 


0099 




LGL 


6 


0100 




TRA 


CMPRA 


0101 


TEMP 


PZE 




0102 




END 




0103 



*••*•••••*••**•••»»»***« PROGRAM LISTINGS 

• CMPRFL * 



REFER TO 
CMPRA 



* CMPRFL * 
•*•«*•••«•*•*••••**••»»* 

REFER TO 
CMPRA 
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» CNTRDB (SUBROUTINE) 9/9/64 LAST CARD IN DECK IS NO. 0250 

• LABEL 0001 

CCNTRDB 0002 
SUBROUTINE CNTRDB ( IT APE , ISENSE, GZFAMP , VOFXY, LXV , 0003 
1 LYV, LXDIM, VZERO, SPACE, IANS) 0004 

C 0005 

C 0006 

C ABSTRACT 0007 

C 0008 

C TITLE - CNTRDB 0009 

C CONTOUR A MATRIX ON THE PRINTER IN DECIBELS 0010 

C 0011 

C CNTRDB IS DESIGNED PRIMARILY TO PLOT AMPLITUDE OR 0012 

C POWER SPECTRA IN TWO DIMENSIONS OVER ONE-HALF THE 0013 

C TWO-DIMENSIONAL PLANE. 0014 

C 0015 

C 0016 

C LANGUAGE - FORTRAN- I I SUBROUTINE 0017 

C EQUIPMENT - 709, 7090, 7094 (MAIN FRAME PLUS ONE TAPE UNIT AND 0018 

C POSSIBLY THE ON-LINE PRINTER) 0019 

C STORAGE - 550 REGISTERS 0020 

C SPEED - A 25 BY 50 MATRIX TAKES ABOUT 15 SECONDS ON THE 7094. 0021 

C AUTHOR - S.M.SIMPSON, MARCH 1964 0022 

C 002 3 

C 0024 

C USAGE 0025 

C 0026 

C TRANSFER VECTOR CONTAINS ROUTINES - SETVEC , CONTUR, SAME 0027 

C AND FORTRAN SYSTEM ROUTINES - LOG, EXP , ( F IL ) , ( STH ) 0028 

C 0029 

C FORTRAN USAGE 0030 

C CALL CNTRDB(ITAPE,ISENSE, GZFAMP, VOFXY, LXV,LYV, LXDIM, VZERO, 0031 

C I SPACE, IANS) 0032 

C 0033 

C INPUTS 0034 

C 0035 

C ITAPE IS LOGICAL OUTPUT TAPE NO. 0036 

C MUST EXCEED ZERO AND BE LESS THAN 20 . 0037 

C 0038 

C I SENSE IS IGNORED UNLESS IT LIES IN THE RANGE 1-6 . 0039 

C IF IT IS IN THE RANGE 1-6 THEN DEPRESSING 0040 

C SENSE SWITCH ISENSE WILL CAUSE ON-LINE 0041 

C MONITORING OF THE CONTOURING (ONLY WHILE DEPRESSED). 0042 

C 0043 

C GZFAMP GRTHN 0 INDICATES THE DATA IN VOFXY IS AMPLITUDE DATA. 0044 

C EQUAL 0 INDICATES THE DATA IN VOFXY IS POWER DATA. 0045 

C LSTHN 0 INDICATES THE DATA IN VOFXY IS DECIBEL DATA. 0046 

C 0047 

C VOFXY(IX,IY) IX=1...LXV, IY=1...LYV THE DATA MATRIX TO BE 0048 

C CONTOURED. 0049 

C VALUES SHOULD EXCEED ZERO UNLESS GZFAMP LSTHN 0. 0050 

C 0051 

C LXV SHOULD EXCEED 1 . 0052 

C 0053 

C LYV SHOULD EXCEED 1 . 0054 

C 0055 

C LXDIM IS THE DIMENSION IN THE USER'S PROGRAM OF THE INDEX IX 0056 

C IN VOFXY(IX,IY). 0057 

C MUST EQUAL OR EXCEED LXV. 0058 

C 0059 

C VZERO IS IGNORED IF GZFAMP IS LESS THAN ZERO. OTHERWISE THE 0060 

C DECIBELS WILL BE COMPUTED BY 0061 

C DB ^ 20 L0G(V0FXY/VZER0) IF GZFAMP EXCEEDS 0.0 0062 

C 08 = 10 L0G(V0FXY/VZER0) IF GZFAMP EQUALS 0.0 0063 

C 0064 

C SPACE(I) I*1...LSPACE MUST BE AVAILABLE FOR SCRATCH WHERE 0065 

C LSPACE * 204 + LXV + XMAXOF ( 4, 484/LXV) 0066 

C 0067 

C 0068 

C OUTPUTS NO OUTPUTS OR ONLY PARTIAL ONES IF IANS IS NON-ZERO. 0069 

C 0070 

C THE PRINCIPAL OUTPUTS ARE OFF-LINE AND POSSIBLY ON-LINE. 0071 

C THE CONTOUR AREA OCCUPIES 121 COLUMNS (12 INCHES) AND 0072 

C 145 ROWS (24 INCHES). 0073 

C VOFXYd, 1) IS UPPER LEFT, VOFXY(LXV, 1) IS UPPER RIGHT 0074 
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c 




VOFXY(t,LYV) IS LOWER LEFT, VOFXY(LXV,LYV) IS LOWER 


RIGHT 


0075 


c 










0076 


c 




VOFXY 


IS CONVERTED INTO DECIBELS (IF GZFAMP GRTHN«0), 


0077 


c 




CONTOURED, AND THEN RECONVERTEC TO ITS ORIGINAL UNITS. 


0078 


c 










0079 


c 




THE CONTOUR LEVELS AND CORRESPONDING CHARACTERS ARE 




0080 


c 






DB=0.0 IS THE CHARACTER Z 




008 1 


c 










0082 


u 




DB 


CHAR DB CHAR DB CHAR DB CHAR 


0083 


c 




-1.0 


1 -17.0 1 1.0 A 17.0 




0084 


c 




-2.0 


2 -20.0 2 2.0 B 20.0 


L 


0085 


c 




-3.0 


3 -25.0 3 3.0 C 25.0 


M 


0086 


c 




-4.0 


4 -30.0 4 4.0 D 30.0 


N 


0087 


c 




-5.0 


5 -35.0 5 5.0 E 35.0 


U 


0088 


c 




-6.0 


6 -40.0 6 6.0 F 40.0 


D 
r 


0089 


(- 
L 




-8.0 


7 -50.0 7 8.0 G 50.0 


n 
w 


nnnn 
UUtU 


c 




-10.0 


8 -60.0 8 10.0 H 60.0 


R 


009 1 


L 




-12.0 


9 -70.0 9 12.0 I 70.0 


S 


0092 


c 




-14.0 


0 -80.0 0 14.0 J 80.0 


T 


0093 


c 










0094 


c 










0095 


c 




THE ABOVE TABLE IS PRINTED FOLLOWING THE CONTOURS* 




0096 


c 










0097 


c 


line VC f T V 
VUr AT \ 1 A 


,IY) MAY 


BE LEFT SLIGHTLY MODIFIED. 




0098 


c 










0099 


c 










01 00 


c 


I ANS 


0 


IF ALL OK 




0101 


c 




-1 


IF LXV ILLEGAL 




0102 


c 




-2 


IF LYV ILLEGAL 




0103 


c 




-3 


IF LXDIM ILLEGAL 




01 04 


c 




-4 


IF VZERO ILLEGAL 




0105 


c 




= -100+K IF CONTUR FOUND AN ERROR IT FLAGGED WITH 


IANS=K 


01 06 


c 










0107 


c 


EXAMPLES 








0108 


c 










0109 


c 


1* IN THIS 


EXAMPLE 


WE SET UP A 25*51 MATRIX WHICH APPROXIMATES 


THE 


0110 


c 


WEIGHTED 


SUPERPOSITION OF 3 POINT SOURCE FIELDS EMANATING FROM 


0111 


c 


I ND ICE S 


<0,10) , 


(25,52), AND (15,25). 




0112 


c 










0113 


c 


USAGE 




DIMENSION V0FXY(30,51), SPACE(IOOO) 




01 1 4 


c 






DO 20 1=1,25 




0115 


c 






DO 20 J=l,51 




0116 


c 






RAD1 = SQRTFt FLOATF { \**2 ♦ (J-10)*#2)) 


- .5 


0117 


c 






RAD2 * SQRTF ( FLOATF ( ( I-25)»«2 ♦ (J-52)*«2)) 




0118 


c 






RAD3 = SQRTF ( FLOATF ( ( I-15)**2 ♦ (J-25)**2)J 


♦ .5 


1)117 


c 




20 


VOFXY(I,J) « 50.0/RAD1 + 100.0/RAD2 ♦ 25.0/RAD3 


0120 


c 






CALL CNTRDB (2, 1, 1 .0, VOFXY, 25, 51, 30, 35. , SPACE , 


IANS) 


uiz l 












moo 


L 


OUTPUTS 


- IANS = 


0, A PAGE RESTORE OCCURS ON LOGICAL 2, THREE 


t\ \ 0"X 


c 




ROWS OF COLUMN LABELLING ARE PRINTED, 145 ROWS OF 




0124 


c 




CONTOURING OCCUR, 3 MORE ROWS OF COLUMN LABELLING 


ARE 


0125 


c 




PRINTED, 3 BLANK ROWS OCCUR, AND 4 ROWS GIVING 




f\ 1 O A 


c 




CONTOUR CODING ARE PRINTED. THE FIRST 67 COLUMNS 


OF 


0 1 27 


c 




THE FIRST 48 PRINTED ROWS APPEAR AS SHOWN BELOW. 




Ul £.0 


c 










0129 


c 


ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo 


0 1 30 


c 


0000000000111111111122222222223333333333444444444455555555556 


0131 


c 


0123456789012345678901234567890123456789012345678901234567890 


0132 


c 


-72 




0 




0133 


c 


-71 




0 




U 1 


c 


-70 


9 


0 




U 1 5z> 


c 


-69 




9 0 




0 1 36 


c 


-68 




9 0 




0137 


c 


-67 




9 0 




0138 


c 


-66 




9 0 






c 


-65 




9 0 




0140 


c 


-64 


8 


9 


0 


0141 


c 


-63 




8 9 


0 


0142 


c 


-62 




8 9 


0 


0143 


c 


-61 




8 9 


0 


0144 


c 


-60 


7 


8 9 




0145 


c 


-59 


7 


8 9 




0146 


c 


-58 




7 8 9 




0147 


c 


-576 




7 8 9 




0148 


c 


-56 


6 


7 8 9 




0149 
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-55 5 

-54 4 

-53 3 

-521 2 



6 

5 6 
4 5 
3 4 5 



6 

6 

-51 Z 12 3 4 5 6 
-50B AZ1 23 4 5 
-49DCBAZ1 23 4 5 
-48FE*BAZ12 34 5 
-47GF*C*Z12 3 4 5 
-46HG**B*1 23 4 5 
-45GF»C*Z12 3 4 5 
-44F*C8AZ12 34 5 
-430CBAZ1 23 4 5 
-42BA Zl 23 4 5 6 
-41 Zl 2 3 4 5 6 
-401 2 3 4 5 6 
-39 3 4 5 6 
-38 4 5 6 
-37 5 6 
-36 6 
-35 6 7 
-34 7 
-33 7 
-32 7 
-31 7 
-30 
-29 
-28 



PROGRAM FOLLOWS BELOW. 



DIMENSION V0FXY(2) , SPACE (41, 3) 



BRING IN AND CHECK SOME STUFF. 

LX=LXV 

L Y-L YV 

LXDM-LXDI M 

VZER=VZER0 
10 IANSR=-1 

IF (LX-2) 9999,20,20 
20 IANSR=-2 

IF (LY-2) 9999,30,30 
30 IANSR=-3 

IF (LXDM-LX) 9999,40,40 

C 

C CONSTRUCT DB AND CHARACTER TABLES 
C 

40 CALL SETVECC SPACE ( I, 1 ) ,-80. ,-70. ,-60., -50., -40. ,-35 i, -30. ,-25. , 

1 -20. ,-17. , -14., -12., -10., -8., -6., -5., -4., -3.,- 2., -l.,0. ,1. ,2., 3., 

2 4., 5. ,6. ,8. ,10., 12., 14., 17., 20., 25., 30., 35., 40., 50., 60., 70., 80.) 
CALL SETVEC(SPACE(1,2),1H0, 1H9, 1H8, 1H7, 1H6, 1H5,1H4,1H3, 1H2,1H1, 

1 1H0,1H9,1H8,1H7,1H6, 1H5, 1H4, 1H3, 1H2, 1H1, 1HZ,1HA,1HB, 1HC, 1HD, 1HE , 

2 1HF,1HG,1HH,1HI,1HJ,1HK,IHL,1HM,1HN,1H0,1HP,1HQ,1HR,1HS,IHT) 

C 

C CONVERT TO DBS IF NECESSARY. 
C 

C0NST=8. 6858896 
IF ( GZFAMP ) 
60 C0NST*4. 3429448 
65 IANSR=-4 

IF (VZER) 
70 DO 100 IX=i,LX 
DO 100 IY=1,LY 
IV*IX+LXDM*< IY-1) 

V0FXYUV)=C0NST*L0GF(V0FXY( IV) /VZER) 
100 CONTINUE 

C 

C FORM THE PLOT 
C 

110 CALL CONTUR( I TAPE , I SENSE , VOFXY, LX, LY , LXDM, 1 . 0, FLOATF ( LX ) , 

1 121, 0, I. 0, FLOATF (LY), 145, -72, 1,0, 

2 SPAC£( l,2),41,0.0,SPACE( 1, 1),SPACE( 1,3), IANSR) 



110,60,65 



9999,9999,70 



*••#•»**»•**•»*•*••»•*•* 
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•*•**•»»•****•*»*•••**»» 
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0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
0197 
0198 
0199 
0200 
0201 
0202 
0203 
0204 
0205 
0206 
0207 
0208 
0209 
0210 
0211 
0212 
0213 
0214 
0215 
0216 
0217 
0218 
0219 
0220 
0221 
0222 
0223 
0224 



••*•«**»•***»***•*•••*•* PROGRAM LISTINGS 

* CNTROB * 

••»«••*«*«***••*«»••*••* 
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IF (IANSR) 140,150,140 
140 IANSR=IANSR-100 
GO TO 9999 

C 

C RESTORE VOFXY IF NECESSARY. 
C 

150 IF (GZFAMP) 220,160,160 
160 DO 200 IX=1,LX 

00 200 IY=1,LY 

IV=IX+LXDM*< IY-1) 

VOFXY ( IV)*VZER*EXPF(VOFXY( IV) /CONST) 
200 CONTINUE 

C 

C RECORD SCALES 
C 

220 DO 230 1^=1,41 

230 SPACE ( l,l)=SAMEF(XFIXF(SPACE< 1,1)) ) 

WRITE OUTPUT TAPE I T APE , 240 , ( SPACE ( I , 1 ) , SP ACE ( I , 2 ) , I 
240 F0RMAT(///30H CONTOUR CODING USED ABOVE IS ,/, 
1 (101 I4,5HDB = ,A1,1H, ) ) ) 

C 

C EXIT, SETTING IANS. 
C 

9999 IANS^IANSR 
RETURN 
END 



» CNTRDB » 
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0225 
0226 
0227 
0228 
0229 
0230 
0231 
0232 
0233 
0234 
0235 
0236 
0237 
0238 
0239 
0240 
0241 

1,41) 0242 
0243 
0244 
0245 
0246 
0247 
0248 
0249 
0250 



••••»*••«**•••**»••• PROGRAM LISTINGS #**♦♦»##**»»***•***#***» 

CNTROW * * CNTROW » 



ABSTRACT 

TITLE - CNTROW 

FIND CONTOUR LEVELS FOR PLOTTING A ROW OF DATA 

CNTROW CONSIDERS A GIVEN VECTOR RANGE AS CONTINUING DATA, 
CONTINUITY TO BE PROVIDED BY CUBIC INTERPOLATION BETWEEN 
THE POINTS. ANOTHER GIVEN VECTOR PROVIDES DESIRED 
CONTOUR LEVEL VALUES, ALTERNATIVELY THE LEVELS ARE 
DEFINED BY A GIVEN LEVEL AND AN INCREMENT. IN ANY CASE 
FOR EACH SUCH LEVEL CNTROW INTERPOLATES THE FIRST VECTOR 
TO FIND ALL CORRESPONDING INDICES ( FRACTIONAL IN 
GENERAL). THESE INDICES ARE ROUNDED TO UNITS 
CORRESPONDING TO COLUMN NUMBERS ON A PRINTED PAGE AND FOR 
EACH SUCH INDEX A HOLLERITH CHARACTER (A SEPARATE 
CHARACTER FOR EACH LEVEL VALUE IS PROVIDED BY A THIRD 
VECTOR) IS INSERTED INTO THE APPROPRIATE POSITION OF A 
HOLLERITH VECTOR. THIS HOLLERITH VECTOR (WHICH WILL BE 
ALL SPACES IF NO CONTOUR LEVELS INTERSECT THE OATA) IS 
THE ONLY OUTPUT OF CNTROW. IN THE CASE THAT 2 LEVELS TRY 
TO CROWD INTO ONE COLUMN POSITION, AN ASTERISK IS 
INSERTED. IF MORE THAN 2, A DOLLAR SIGN IS INSERTED* 



LANGUAGE 
EQUIPMENT 
STORAGE 
SPEED 

AUTHOR 



FORTRAN-II SUBROUTINE 

709 t 7090, 7094 (MAIN FRAME ONLY) 

802 REGISTERS 

TAKES ON THE ORDER OF 1/10 SECOND ON THE 7090 

A 120 COLUMN ROW WITH VECTOR LENGTH 50 . 
S.M.SIMPSON, MARCH 1964 



FOR 



♦ CNTROW (SUBROUTINE) 9/9/64 LAST CARD IN DECK IS NO. 

* LABEL 
CCNTROW 

SUBROUTINE CNTROW (VECLVEC »FXLO»FXH I ,NCOLS» CHLVL St NCHRS, DELE VL, 
1 VLEVL, SPACE, PLOTVC, IANS) 

C 
C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 



USAGE 

TRANSFER VECTOR CONTAINS ROUTINES - CUF I Tl, QUF IT 1,FASCU8 

RND, RNDDN, RNDUP 
AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 

FORTRAN USAGE 

CALL CNTROW (VEC, LVEC, FXLO, FXHI, NCOLS, CHLVLS, NCHRS, DELEVL, 
I VLEVL, SPACE, PLOTVC, IANS) 



INPUTS 



VEC(I) 



LVEC 



FXLO 



FXHI 



NCOLS 



.LVEC IS THE DATA TO BE CONTOURED. THE RANGE OF THE 
INDEX I INVOLVED IS SPECIFIED BY FXLO AND FXHU 



MUST BE GRTHN* 2 



IS 



A FLOATING POINT NUMBER (MAY BE FRACTIONAL) WHICH 
REPRESENTS THE INDEX I OF VEC(I) WHICH IS TO 
CORRESPOND TO THE FIRST COLUMN OF THE OUTPUT 
(IN PLOTVC(D). 
FXLO MUST BE GRIHN= 1.0 . 

REPRESENTS THE INDEX I OF VEC(I) WHICH IS TO CORRESPOND 

TO THE LAST COLUMN OF THE OUTPUT (IN PLOTVC ( NCOLS ) ) 
FXHI MUST EXCEED FXLO, AND MUST BE LSTHN= LVEC. 

IS THE NO. OF COLUMNS OF THE OUTPUT. 
MUST EXCEED ONE. 



CHLVLS(I) 1^1,2,... , NCHRS GIVES THE CHARACTERS USED FOR PLOTTING 
THE CONTOUR LEVELS, EACH REGISTER IN FORMAT (Al). 
THE CHARACTERS • AND $ SHOULD NOT APPEAR HERE SINCE 
CNTROW USES THEM TO INDICATE CONFLICT OF CONTOURS. 
THE RELATION OF CHLVLS TO THE ACTUAL LEVELS DEPENDS 
ON THE MANNER IN WHICH THE LEVELS ARE DEFINED, AS 



0520 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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SPECIFIED BELOW. 

NCHRS IS THE NO* OF CHARACTERS IN THE CHLVLS VECTOR. IT IS 

ALSO THE NO. OF CONTOUR LEVELS IN THE CASE 
DELEVL=0.0 AS DESCRIBED BELOW. 
MUST EXCEED ZERO. 

DELEVL INDICATES THE MANNER OF CONTOUR LEVEL SPECIFICATION. IF 
DELEVL IS NON-ZERO, SUCCESSIVE CONTOUR LEVELS ARE 
ASSUMED TO BE SEPARATED BY DELEVL UNITS WITH A 
STARTING VALUE OF VLEVL i DELEVL MAY NOT BE 
NEGATIVE). ON THE OTHER HAND IF DELEVL IS ZERO, 
VLEVL IS INTERPRETED AS A VECTOR GIVING A FIXED SET 
OF ARBITRARY LEVELS. 
MUST BE GRTHN= 0.0 . 



VLEVL i I ) 1 = ., 



IANS 



EXAMPLES 



HAS INTERPRETATION DEPENDING ON DELEVL. 
IF DELEVL IS NON-ZERO, VLEVL IS A SINGLE CONSTANT 
VLEVLU), WHICH IS THE CONTOUR LEVEL OF VEC TO BE 
ASSOCIATED WITH THE CHARACTER CHLVLSd). 
VLEVL+DELEVL IS TO BE ASSOCIATED WITH CHLVLS<2), 
ETC. THIS ASSOCIATION IS TAKEN TO BE CYCLIC IF 
NECESSARY, I.E., 

VLEVL+(NCHRS-1)*DEL£VL HAS CHARACTER CHLVLSi NCHRS ) 
VLEVL +NCHRS*DELEVL HAS CHARACTER CHLVLS(l) 

ETC. 

ALSO 

VLEVL-DELEVL HAS CHARACTER CHLVLSINCHRS ) 



ETC. 



FOR LOWER LEVELS. 



SPACE U) 



OUTPUTS 



PLOTVC(I) 



IF DELEVL IS ZERO, VLEVL IS TAKEN AS A VECTOR, 
VLEVLU... NCHRS), OF INDIVIDUAL CONTOUR LEVELS 
WHICH CORRESPOND 1 TO 1 WITH THE CHARACTERS OF 
CHLVLSd... NCHRS). THESE CONTOUR LEVELS MUST BE 
MONOTONELY INCREASING IN SIZE. 

1=1,2,... ,LSPACE MUST BE AVAILABLE FOR SCRATCH, 

WHERE LSPACE = 2+XMAXOF (4,4*NC0LS/NINDRS) , 

WHERE NINDRS = (FXHI) ROUNDED UP - (FXLO) ROUNDED DOWN. 



(OUTPUT OCCURS ONLY FOR IANS=0) 

1=1,2,... ,NCOLS WILL BE FILLED WITH CHARACTERS FROM 
CHLVLSd), BLANKS, AND POSSIBLY ASTERISKS AND 
DOLLAR SIGNS, ALL IN FORMAT(lAl) 



0 
-1 
-2 
-3 
-4 
-5 
-6 
-7 



NORMALLY 

FOR ILLEGAL LVEC 
FOR ILLEGAL FXLO 
FOR ILLEGAL FXHI 
FOR ILLEGAL NCOLS 
FOR ILLEGAL NCHRS 
FOR ILLEGAL DELEVL 
FOR ILLEGAL VLEVL 



(NOT MONOTONE IN CASE DELEVL=0. } 



WE SHALL ASSUME THE FOLLOWING VECTORS AS INPUTS. 



VEC2U...2) 
VEC3U...3) 
VEC4C 1...4) 
VEC5d*..5) 
VEC9U...9) 



VEC2R( 1.. 
VEC3RU.. 
VEC4Rd.. 
VEC5R(1.. 
CLVLSld. 
CLVLS2U. 



2 

3) 
4) 
5) 

.10) 
.11) 



CLVLS9C1...14) 



* 0.0,10.0 
0.0,5.0,10.0 

- 0.0,3.33333333,6.66666667,10.0 
= 0.0,2.5,5.0,7.5,10.0 

= -47.0,-13.0,3.0,7.0,5.0,3.0,7.0,23.0,57.0 
= 10.0,0.0 

* 10.0,5.0,0.0 

* 10.0,6.66666667,3.33333333,0.0 
= 10.0,7.5,5.0,2.5,0.0 

= 1H0, 1H1, 1H2, 1H3, 1H4, 1H5, 1H6, 1H7, 1H8, 1H9 
* 1H0,1H1,1H2, IH3, 1H4,1H5,1H6,1H7,1H8,1H9, 

1H0 

= IHD,1HC,1HB, 1HA, 1H0, 1H1, 1H2, IH3,1H4,1H5, 
1H6,1H7,1H8, 1H9 
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0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
Olil 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
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C VLEVL2(l...il) * 0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0, 0149 

C 10.0 0150 

C 0151 

C 1. USAGES - CALL CNTROW ( VEC2, 2, 1 • , 2. , 21,CLVLS 1, 10, 1. ,0.0, SPACE, 0152 

C 1 PLV2A,INS2A> 0153 

C CALL CNTR0W(VEC3,3,1.,3.,21,CLVLS1,10,1.,0.0,5PACE, 0154 

C 1 PLV3A,INS3AJ 0155 

C CALL CNTR0W(VEC4,4,1.,4.,21»CLVLS1,10,1.,0.0,SPACE, 0156 

C 1 PLV4A,INS4A) 0157 

C CALL CNTR0W(VEC5,5,l.,5.,21,CLVLSi,10,l.,0.0,SPACE, 0158 

C 1 PLV5A,INS5A) 0159 

C OUTPUTS - PLV2A(1..,21)=...=PLV5A( l...21)=21H0 1 234567890 0160 

C INS2A*...*INS5A = 0 0161 

C 0162 

C 2. USAGES - CALL CNTROWC VEC2, 2, 1 ., 2. , 21,CLVLS2, 1 1, 0. , VLEVL2 , 0163 

C 1 SPACE » PL V2B» INS 2B ) 0164 

C CALL CNTR0W(VEC3,3,l.,3.,21,CLVLS2,ll,0.,VLEVL2, 0165 

C 1 SPACE, PLV3B, INS3B) 0166 

C CALL CNTR0W(VEC4,4,1.,4.,21,CLVLS2,11,0.*VLEVL2, 0167 

C 1 SPACE, PLV4B, INS4B) 0168 

C CALL CNTR0W(VEC5,5,1.,5.,21,CLVLS2,11,0.#VLEVL2, 0169 

C 1 SPACE, PLV5B, INS5B) 0170 

C OUTPUTS - PLV2BU...21) = ... = PLV58< 1...21) = 21H0 1234567890 0171 

C INS2B*...=INS5B * 0 0172 

C 0173 

C 3. USAGES - CALL CNTROW ( VEC2R, 2, 1., 2., 21, CL VLSI, 10,1., 0.0, 0174 

C 1 SPACE, PLV2RA, INS2RA) 0175 

C CALL CNTROW(VEC3R,3,l.,3.,2l,CLVLSl,10,l.,0.0, 0176 

C 1 SPACE, PLV3RA, INS3RA) 0177 

C CALL CNTROW(VEC4R,4,l.,4.,21,CLVLSl,10,i.,0.0, 0178 

C 1 SPACE, PLV4RA, INS4RA) 0179 

C CALL CNTR0W(VEC5R,5,1.,5.,21,CLVLS1,10,1.,0.0, 0180 

C 1 SPACE, PLV5RA, INS5RA ) 0181 

C OUTPUTS - PLV2RA(U..21) = .. = PLV5RA(1...21)=21H0 9876543210 0182 

C INS2RA=...=INS5RA = 0 0183 

C 0184 

C 4. USAGES - CALL CNTROW ( VEC2R, 2, 1. , 2. , 2 1 , CLVLS2, 11,0., VLEVL2, 0185 

C 1 SPACE, PLV2RB, INS2RB ) 0186 

C CALL CNTR0W(VEC3R,3,l.,3.,2i,CLVLS2,ll,0.,VLEVL2, 0187 

C 1 SPACE, PLV3RB,INS3R8) 0188 

C CALL CNTROW( VEC4R,4, i. , 4. , 2 1, CLVL S2, 1 1 , 0. , VLEVL2 , 0189 

C 1 SPACE, PLV4RB, INS4RB) 0190 

C CALL CNTR0W(VEC5R,5, 1. , 5. , 21 , CLVLS2 , 1 1 , 0. , VLEVL2 , 0191 

C 1 SPACE, PLV5RB, INS5RB) 0192 

C OUTPUTS - PLV2RB(1...2l)=..=PLV5RB< 1...21)=21H0 9876543210 0193 

C INS2RB=...=INS5RB * 0 0194 

C 0195 

C 5. USAGE - CALL CNTROW ( VEC9, 9, 2.5, 8. 5, 16, CLVLS9, 14, 5.0,-20.0, 0196 

C I SPACE, PLTVC9, IANS9) 0197 

C OUTPUTS - PLTVC9U...16) » 16HA01 1 12*»$ IANS9 » 0 0198 

C 0199 

C 0200 

C PROGRAM FOLLOWS BELOW 0201 

C 0202 

C 0203 

C DUMMY DIMENSIONS 0204 

C 0205 
DIMENSION VEC(2),CHLVLS(2),VLEVL(2),PL0TVC(2),SPACE(2) 0206 

C 0207 

C TRUE DIMENSIONS 0208 

C 0209 
DIMENSION C0EFS(4) 0210 
EQUIVALENCE ( CZ ,COEFS ( 1 ) ) , ( CI, COEFS ( 2 ) ) , ( C2,C0EFS( 3 ) 3 , 0211 
1 (C3,C0EFS(4)) 0212 

C 0213 

C BRING IN SOME STUFF 0214 

C 0215 
LVC'LVEC 0216 
FXL^FXLO 0217 
FXH=FXHI 0218 
NCLS^NCOLS 0219 
NCRS^NCHRS , 0220 
DLEVL=DELEVL 0221 
VLVL=VLEVL 0222 

C 0223 
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C CHECK INPUTS 0224 

C 0225 

IANSR=-1 0226 

IF (LVC-2) 9999,5,5 0227 

5 IANSR=-2 0228 

IF (FXL-1.0) 9999,10,10 0229 

10 I ANSR=-3 0230 

IF ( FXH-FXL ) 9999,9999,15 0231 

15 IF ( FXH-FLOATF( LVC ) ) 20,20,9999 0232 

20 IANSR=*-4 0233 

IF (NCLS-2) 9999,30,30 0234 

30 IANSR=-5 0235 

IF (NCRS) 9999,9999,35 0236 

35 IANSR=-6 0237 

IF (DLEVL) 9999,40,40 0238 

40 IF (DLEVL) 80,50,80 0239 

50 IF (NCRS-i) 80,80,60 0240 

60 IANSR=-7 0241 

N=NCRS-1 0242 

DO 70 1=1, N 0243 

IF ( VLEVL ( I +1 3-VLEVL ( I ) ) 9999,9999,70 0244 

70 CONTINUE 0245 

80 IANSR*0 0246 

C 0247 

C INPUTS OK. INITIALIZE. 0248 

C 0249 

C 1. SET INDEX RANGE FOR VEC(I) AND NO. OF INDEX RANGES 0250 

C FOR LOOP ( NINDRS ) 0251 

C 2. FILL OUTPUT VECTOR WITH SPACES 0252 

C 3. INITIALIZE MAJOR LOOP INDEX IXVEC TO IXLO 0253 

C 4. SET CONSTANTS C0LC1 , COLCZ , STAR, DOLAR, SPACES, 0254 

C DEI.X , ABSDEL 0255 

C 0256 

IXLO=XFIXF(RNDDNF(FXL) ) 0257 

IXHI=XFIXF(RNDUPF(FXH) ) 0258 

NINDRSMXHI-IXLO 0259 

DO 100 I=1,NCLS 0260 

B PLOTVC 1 1 )*606060606060 0261 

100 CONTINUE 0262 

IXVEC^IXLO 0263 

C0LC1*(FL0ATF(NCLS-1 ) )/ ( FXH-FXL ) 0264 

C0LCZ«1.0-FXL«C0LC1 0265 

STAR=1H» 0266 

D0LAR=1H$ 0267 

B SPACES=606060606060 0268 

NF=XMAX0F(4,4»NCLS/NINDRS) 0269 

FNF-FLOATF ( NF ) 0270 

DELX1=FNF 0271 

VBIGST=10*0E30 0272 

MXDOLS * 100 0273 

NDOLS * 0 0274 

C 0275 
C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 0276 

C 0277 

C MAJOR LOOP ON IXVEC (INDEXING AT 700 UP THRU IXHI-l) 0278 

C 0279 

C THE FIRST ENTERPRISE IS TO OBTAIN A CUBIC (MAY BE DEGENERATE) 0280 

C WHICH IS VALID FOR THE REGION IXVEC TO IXVEC+l . ORDINARILY THE 0281 

C CUBIC IS FITTED TO VEC( IXVEC-1, IXVEC, IXVEC+l, IXVEC+2). HOWEVER, 0282 

C VEC( IXVEC-1) OR VECUXVEC+2) OR BOTH MAY BE UNAVAILABLE IN THE 0283 

C CASE THAT IXVEC LIES AT ONE END OF THE RANGE. 0284 

C 0285 

C 0286 

C VEC(IXVEC-l) IS UNAVAILABLE I.F.F. IXVEC^l 0287 

C 0288 

130 IF (IXVEC-1) 160,160,140 0289 

C 0290 

C IF VEC( IXVEC-1) IS AVAILABLE, VEC ( I XVEC+2 ) WILL BE AVAILABLE ALSO 0291 

C I.F.F. LVC EXCEEDS IXVEC+l . JUMP AHEAD TO CUBIC FIT IN THIS CASE 0292 

C 0293 

140 IF (LVC-IXVEC-1) 150,150,200 0294 

C 0295 
C WHEN VEC(IXVEC-l) IS AVAILABLE AND VECtIXVEC+2) IS NOT, WE SET TO FIT 0296 

C A PARABOLA TO VEC ( IXVEC-1 ) ,VEC( IXVEC) ,VEC ( IXVEC+l ) WITH XLO=-FNF 0297 
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C AND THEN JUMP AHEAD TO FIT IT, 0298 

C 0299 

150 IXFS=IXVEC-1 0300 

XtO=-FNF 0301 

GO TO 190 0302 

C 0303 

C WHEN VEC(IXVEC-l) IS UNAVAILABLE, VECUXVE02) WILL BE UNAVAILABLE 0304 

C ALSO I.F.F. LV02 . 0305 

C 0306 

160 IF (LVC-2) 170,170,180 0307 

C 0308 

C WHEN BOTH VEC(IXVEC-l) AND VECUXVEC+2) ARE UNAVAILABLE WE SET THE 0309 

C CUBIC AS A LINEAR SEGMENT SUCH THAT 0310 

C F(0.0)*V6C( IXVEC) F( FNF)=VEC( IXVEC+1) 0311 

C 0312 

170 C2=0.0 0313 

C3=0.0 0314 

C1=(VEC( IXVEC+1)-VEC( IXVEC) )/FNF 0315 

CZ=VEC( IXVEO+Cl 0316 

GO TO 210 0317 

C 0318 

C WHEN VEC(IXVEC-l) IS UNAVAILABLE BUT VEC< IXVEC+2 > IS AVAILABLE* WE 0319 

C SET TO FIT A PARABOLA TO VEC ( IX VEC ) , VEC U XVEC+l 3 , VEC ( I XVEC+2) 0320 

C WITH XLO^O.O 0321 

C 0322 

180 IXFS=IXVEC 0323 

XL0=0.0 0324 

C 0325 

C USE QUFIT1 TO FIND THE PARABOLA. 0326 

C 0327 

190 C3=0.0 0328 

CALL QUFIT1(VEC(IXFS),XL0,DELX1,C0EFS) 0329 

GO TO 210 0330 

C 0331 

C USE CUFIT1 TO FIND THE CUBIC. 0332 

C 0333 

200 IXFS=IXVEC-1 0334 

XL0=-FNF 0335 

CALL CUFIT1(VEC(IXFS),XL0,DELXI,C0EFS) 0336 

C 0337 

C 0338 

C MERGE POINT AFTER FINDING CUBIC. 0339 

C 0340 

C NOW EVALUATE CUBIC F(X) FOR X=0 .0 , 1 .0 , 2 .0 ,...,( FNF- 1 . 0 ) 0341 

C INTO SPACE(2,3,...,NF+1) 0342 

C EXCEPT GET ONE MORE VALUE AT IXVEC=IXHI-1 0343 

C (NOTE INSERTION RATHER THAN COMPUTATION OF END VALUES) 0344 

C 0345 

210 NFEV^NF 0346 

IF ( IXVEC+l-IXHI) 220,215,215 0347 

215 NFEV=NF+1 0348 

SPACE(NF+2)=VEC( IXHI ) 0349 

220 CALL FASCUB(C0EFS,0.,1.,NF,SPACE(2) ) 0350 

SPACE(2)=VEC( IXVEC) 0351 

C 0352 

C IF THIS IS FIRST RANGE, WE HAVE SOME INITIALIZING. 0353 

C 0354 

IF (IXVEC-IXLO) 230,230,300 0355 

C 0356 

C THE INITIALIZING CONSISTS OF 0357 

C 1. SETTING SPACE(l) = CUBIC F(X) AT X=-1.0 0358 

C 2. VA AND VB * CONTOUR LEVELS SUCH THAT 0359 

C VB LSTHN SPACE(l) LSTHN= VA 0360 

C 3. IXLEVA * INDEX OF LEVEL VA (VLEVL CORR. TO IXLEVA=0) 0361 

C 0362 

230 CALL FASCU8(C0EFS, -1.0, 1.0,1, SPACE( 1) ) 0363 

TEMP=SPACE(1) 0364 

IF (DLEVL) 270,270,240 0365 

C 0366 

C CONSTANT INCREMENT CASE 0367 

C 0368 

240 IF (TEMP-VLEVL) 260,250,250 0369 

250 IXLEVA * XF I XF ( RNDUPF ( ( TEMP- VLEVL ) /DL EVL ) ) 0370 

255 VA=VLEVL+FLOATF( I XLE VA ) *DLEVL 0371 

VB-VA-DLEVL 0372 
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GO TO 300 

260 IXLEVA * XFI XF (RNDDNFi ( TEMP-VLEVL ) /DLEVL ) ) 
GO TO 255 

C 

C LIST CASE (SPECIAL CASES IF TEMP LSTHN= VLEVL(l) OR GRTHN VLEVL ( NCRS )-J 
C 

270 IXLEVA-0 

VB=-VBIGST 
275 VA*VLEVL(IXLEVA+1) 

IF (TEMP-VA) 300,300,280 
280 IXL£VA=IXL£VA+1 

V8-VA 

IF (IXLEVA-NCRS) 275,285,285 
285 VA=VBIGST 
GO TO 300 

C 

C INITIALIZE FOR THE SCAN OF 

C SPACE (2), SPACE (3 ),..., SPACE (NFEV+1) 

C 

300 IEQ'O 
IXSP=2 

C 

C SCAN 
C 

320 TEMP=SPACE(IXSP) 

IF (TEMP-VA) 330,325,370 
IEQ*1 
GO TO 370 

IF ( TEMP-VB ) 410,335,340 
IEQ=1 
GO TO 410 



325 



330 
335 



C INDEX FOR MORE. IF NONE, RESET SPACE(l) AND ON TO NEXT IXVEC. 
C 

340 IXSP=IXSP+1 

IF (IXSP-NFEV-1) 320,320,350 
350 SPACE (i)=SPACE(NF+l) 

GO TO 700 

C 

C THIS SEQUENCE RESETS FOR THE CASE WHERE VA WAS EQUALLED OR EXCEEDED 



C (THEN ON TO FIND COLUMN, ETC.) 

C 

370 V»VA 

IXLEV=IXLEVA 
VB^VA 

IXLEVA=IXLEVA+l 

IF (DLEVL) 380,380,375 
375 VA=VA+DLEVL 

GO TO 450 
380 IF (IXLEVA-NCRS) 385,390,390 
385 VA=VLEVL( IXLEVA+1) 

GO TO 450 
390 VA*VBIGST 

GO TO 450 

C 

C THIS SEQUENCE RESETS FOR THE CASE WHERE VB WAS EQUALLED OR SUBCEEDED 



: (THEN ON TO FIND COLUMN NO.) 

410 V*VB 

IXLEV=IXLEVA-1 
VA=VB 

IXLEVA*IXLEVA-1 

IF (DLEVL) 425,425,420 
420 VB«VB-DLEVL 

GO TO 450 
425 IF (IXLEVA) 430,430,435 
430 VB«-VBIGST 

GO TO 450 
435 VB*VLEVL( IXLEVA) 

GO TO 450 



C DETERMINATION OF COLUMN NO. 
C 

C DEFINITIONS - FIXUNF IS INDEX OF CONTOUR WRT 0,l,.i 

C FIXVC IS INDEX OF CONTOUR WRT IXVEC 



>,NF-l 



(FLTG) 
(FLTG) 



0373 
0374 
0375 
0376 
0377 
0378 
0379 
0380 
0381 
0382 
0383 
0384 
0385 
0386 
0387 
0388 
0389 
0390 
0391 
0392 
0393 
0394 
0395 
0396 
0397 
0398 
0399 
0400 
0401 
0402 
0403 
0404 
0405 
0406 
0407 
0408 
0409 
0410 
0411 
0412 
0413 
0414 
0415 
0416 
0417 
0418 
0419 
0420 
0421 
0422 
0423 
0424 
0425 
0426 
0427 
0428 
0429 
0430 
0431 
0432 
0433 
0434 
0435 
0436 
0437 
0438 
0439 
0440 
0441 
0442 
0443 
0444 
0445 
0446 
0447 
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(PAGE 7) ( PAGE 

C ICOLNO IS COLUMN NO. (ROUNDED) 0448 

C (MUST BE IN RANGE 1 TO NCOLS) 0449 

C 0450 
C WE HAVE TO WATCH OUT FOR THE CASE IN WHICH SPACE(IXSP) * SPACE ( IXSP-1) 0451 

C 0452 

450 TEMP«SPACE(IXSP)-SPACE( IXSP-1) 0453 

IF (TEMP) 460,455,460 0454 

455 FIXUNF=FL0ATF( IXSP-3)+.5 0455 

GO TO 465 0456 

460 FIXUNF=FL0ATFUXSP-3) + (V-SPACE< IXSP-1 ) ) /TEMP 0457 

465 FIXVC*FLOATF( I XVEC ) +F IXUNF/FNF 0458 

ICOLNO * XFIXF(RNDF(C0LCZ+FIXVC»C0LC1)) 0459 

IF (ICOLNO) 660,660,470 0460 

470 IF UCOLNO-NCLS) 500,500,660 0461 

C 0462 

C CHECK WHETHER OR NOT THIS COLUMN IS ALREADY OCCUPIED. 0463 

C 0464 

500 CHLAST=PLOTVC ( ICOLNO ) 0465 

IOCC = 1 0466 

IF (CHLAST-SPACES) 540,570,540 0467 

C 0468 

C IT IS. F I NO OUT WHETHER * OR $ OR SOMETHING ELSE. 0469 

C AND ACT ACCORDINGLY. 0470 

C 0471 

540 IF (CHLAST-STAR) 550,545,550 0472 

545 CHAR=DOLAR 0473 

GO TO 650 0474 

550 IF (CHLAST-DOLAR) 575,560,575 0475 

560 NDOLS = NDOLS+l 0476 

IF (NDOLS-MXDOLS) 660,660,700 0477 

C 0478 

C IT IS NOT OCCUPIED YET. 0479 

C FIRST TAKE CARE OF THE EASY CASE, DLEVL^O . 0480 

C 0481 

570 IOCC « 0 0482 

575 IF (DLEVL) 580,580,600 0483 

580 CHAR*CHLVLS( IXLEV+1) 0484 

GO TO 627 0485 

C 0486 

C FOR THE OTHER CASE, THE INDEX FOR CHLVLS IS A MODULO 0487 

C TYPE FUNCTION OF IXLEV. 0488 

C 0489 

600 IXCR=XM0DF( IXLEV, NCRS) 0490 

IF (IXCR) 620,625,625 0491 

620 IXCR-IXCR+NCRS 0492 

625 CHAR=CHLVLS( IXCR+1) 0493 

627 IF (IOCC) 630,650,630 0494 

630 IF (CHAR-CHLAST) 635,660,635 0495 

635 CHAR « STAR 0496 

GO TO 650 0497 

C 0498 

C OK. MOVE THE CHARACTER INTO POSITION 0499 

C 0500 

650 PLOTVCUCOLNO)=CHAR 0501 

C 0502 

C CHECK IEQ FOR RETURN AND CLEAR IT. 0503 

C 0504 

660 IF (IEQ) 665,320,665 0505 

665 IEQ=0 0506 

GO TO 340 0507 

C 0508 

C INDEX IXVEC AND GO BACK FOR MORE IF WE AREN'T DONE. 0509 

C 0510 

700 IANSRaO 0511 

IXVEC=IXVEC+1 0512 

NDOLS « 0 0513 

IF (IXVEC-IXHI) 130,9999,9999 0514 

C 0515 

C EXIT, SETTING IANS 0516 

C 0517 

9999 IANS=IANSR 0518 

RETURN 0519 

END 0520 
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* COLABL ( SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO* 0123 

* LABEL 0001 
CCOLABL 0002 

SUBROUTINE COLABL ( ITAPE , ICOLLO, NCOLLO, NCOLS, ISPACE) 0003 

C 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - COLABL 0008 

C LABEL PRINTER COLUMNS WITH INCREASING 3-DIGIT INTEGERS 0009 

C 0010 

C COLABL LABELS A SPECIFIED RANGE OF PRINTER COLUMNS 0011 

C (OFF-LINE) WITH 3-DIGIT INTEGERS DISPLAYED VERTICALLY, 0012 

C WHERE USER SPECIFIES LEFTMOST INTEGER AND WHERE 0013 

C SUBSEQUENT INTEGERS ARE INDEXED BY UNITY. 0014 

C 0015 

C 0016 

C LANGUAGE - FORTRAN-I I SUBROUTINE 0017 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ♦ 1 TAPE UNIT) 0018 

C STORAGE - 185 REGISTERS 0019 

C SPEED - TAKES ABOUT 1/6 SECOND TO LABEL 130 COLUMNS ON 7094. 0020 

C AUTHOR - S.M.SIMPSON, MARCH 1964 0021 

C 0022 

C 0023 

C USAGE 0024 

C 0025 

C TRANSFER VECTOR CONTAINS ROUTINES - GENHOL 0026 

C AND FORTRAN SYSTEM ROUTINES - ( SPH ) , ( F IL ) , ( STH ) 0027 

C 0028 

C FORTRAN USAGE 0029 

C CALL COLABU ITAPE, ICOLLO, NCOLLO, NCOLS, ISPACE) 0030 

C 0031 

C 0032 

C INPUTS 0033 

C 0034 

C ITAPE IS LOG* TAPE UNIT FOR OUTPUT. 0035 

C 1 LSTHN« ITAPE LSTHN= 20 . 0036 

C 0037 

C ICOLLO IS COLUMN NO. WRT PRINTER WHERE LABELLING STARTS. 0038 

C MUST BE GRTHN* I . 0039 

C 0040 

C NCOLLO IS LABEL FOR PRINTER COL. NO. ICOLLO* 0041 

C MUST BE GRTHN* 0 . 0042 

C 0043 

C NCOLS IS NO. OF SUCCESSIVE COLUMNS TO BE LABELLED. 0044 

C MUST BE GRTHN* 1 . 0045 

C 0046 

C ISPACE(I) 1=1. ..NCOLS IS SCRATCH AREA. 0047 

C 0048 

C 0049 

C OUTPUTS STRAIGHT RETURN FOR ILLEGAL ITAPE. OTHER INPUTS NOT CHKD. 0050 

C 0051 

C ONLY OUTPUT IS 3 LINES OF PRINTED OUTPUT AS ILLUSTRATED 0052 

C IN THE EXAMPLES. 0053 

C 0054 

C 0055 

C EXAMPLES 0056 

C 0057 

C 1. USAGES - DIMENSION ISPACE(130) 0058 

C CALL C0LABL(2,2,2,130,ISPACE) 0059 

C OUTPUTS - COLS. 2-131 LABELLED 0 000 Oil 1 OFF-LINE* 0060 

C 0.. .011.. .900.. .3 0061 

C 2 901 901 1 0062 

C 0063 

C 2. USAGES - CALL COLABL ( 2, 51 , 1, 15, ISPACE ) 0064 

C OUTPUTS - COLS. 51-65 LABELLED 0065 

C 000000000000000 0066 

C 000000000111111 0067 

C 123456789012345 0068 

C 0069 

C 3. USAGE - CALL COLABL ( 2, 17,4, 1, ISPACE ) 0070 

C OUTPUT - COL. 17 IS LABELLED 4 . 0071 

C 0072 

C 0073 
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PROGRAM FOLLOWS BELOW. 

DUMMY DIMENSION 

DIMENSION ISPACE(2> 
TRUE DIMENSION 

DIMENSION FMTO) 
CHECK INPUTS 



IF (ITAPE) 
IF (ITAPE-20) 



9999,9999,5 
45,45,9999 



INPUTS OK. SET UP FORMAT VECTOR. 



45 NBLANK* ICOLLO-i 

IF (NBLANK) 50,50,60 
50 CALL GENHOL ( FMT ) 

PRINT 55 
55 FORMAT (7H( 13011} ) 

GO TO 70 
60 CALL GENHOL { FMT ) 

PRINT 65, NBLANK 
65 FORMAT(IH(,I3,8HX,130I1) ) 

GO TO 70 



SET UP AND EXECUTE LOOPS. 



70 NC0LHI=NC0LL0+NC0LS~1 

DO 100 IR0W=a,3 

DO 95 NCOLNO*NCOLLO,NCOLHI 

IHUNS=NC0LN0/100 

ITENS=(NC0LN0-IHUNS*100)/10 

I0NES*NC0LN0-IHUNS*100-ITENS*10 

IF UROW-2) 75,80,85 
75 INO=IHUNS 

GO TO 90 
80 INO^ITENS 

GO TO 90 
85 INO=IONES 

GO TO 90 
90 I XSP=NC0LN0-NCQLL0+1 
95 ISPACE(IXSP)*INO 

99 WRITE OUTPUT TAPE I T APE , FMT, < IS PACE < I ) , 1 = 1, NCOL S ) 

100 CONTINUE 
9999 RETURN 

END 



{ PAGE 2) 

0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 



•*«»•»*•«•***•*•*»»•»»** PROGRAM LISTINGS #**#*#*•»**»••»****«•»*♦ 

• COLAPS * ♦ COLAPS » 

•»»****»•»»••*•**»»*•*»• ****••»•••*»••••••**«••• 



• COLAPS (SUBROUTINE) 9/29/64 LAST CARO IN DECK IS NO. 0127 

• FAP 0001 
•COLAPS 0002 

COUNT 100 0003 

LBL COLAPS 0004 

ENTRY COLAPS ( X,N,TYPE,XC,M) 0005 

• 0006 

• ABSTRACT—— 0007 

» 0008 

• TITLE - COLAPS 0009 

• COLLAPSE ONE-SIDED VECTOR INTO SMALLER RANGE 0010 
» 0011 

• COLAPS COLLAPSES A VECTOR X OF LENGTH N TO A VECTOR XC OF 0012 

• LENGTH M. THE COLLAPSED SERIES IS DEFINED BY 0013 

• 0014 
» XCU) » X(I) ♦ XU+M) ♦ XU+2M) ♦ ... ♦ XU*MI)*M) 0015 

• 0016 

• FOR I » l f 2i...|H 0017 

• MI) * (N/M) FOR I LSTHN= N(MODULO M) 0018 

• = (N/M}-1 FOR I GRTHN N(MODULO M) 0019 

• N/M IS ROUNDED DOWN 0020 

• 0021 

• IF M IS GRTHN N ZEROS ARE FILLED INTO XC FOR ALL I GRTHN N 0022 

• 0023 

• LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0024 

• EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0025 
•STORAGE - 50 REGISTERS 0026 

• SPEED - ABOUT 6N + 14M MACHINE CYCLES 0027 

• AUTHOR - J. CLARK 0028 

• 0029 

• USAGE 0030 

• 0031 

• TRANSFER VECTOR CONTAINS ROUTINES - NONE 0032 

• AND FORTRAN SYSTEM ROUTINES - NONE 0033 

• 0034 

• FORTRAN USAGE 0035 

• CALL COLAPSU, M» TYPE, XC, M) 0036 
» 0037 

• INPUTS 0038 

• 0039 

• X(I) 1=1.. .N IS FLOATING OR FIXED (FORTRAN II) POINT VECTOR 0040 

• OF NUMBERS. (NAME NEED NOT BE FLOATING POINT.) 0041 

• 0042 

• N IS FORTRAN II INTEGER. 0043 

• MUST 8E GRTHN= 1 . 0044 

• 0045 

• TYPE * 0. IF X IS FIXEO POINT. 0046 

• NOT* 0. IF X IS FLOATING POINT. 0047 

• 0048 

• M IS THE LENGTH OF THE COLLAPSED SERIES. 0049 

• IS FORTRAN II INTEGER. 0050 

• MUST BE GRTHN- I . 0051 

• MAY BE GRTHN= N . 0052 

• 0053 

• OUTPUTS 0054 

• 0055 

• XCU) I-1...M IS THE COLLAPSED X SERIES. (NAME NEED NOT BE 0056 

• FLOATING POINT.) 0057 
» PROGRAM EXITS WITHOUT COMPUTATION IF N OR M I S ILLEGAL. 0058 

• 0059 
» EXAMPLES 0060 

• 0061 
» 1. INPUTS - XU...6) = l.,3.,4.,2.,-l.,~2. N*6 TYPE*l. M=3 0062 

• OUTPUTS - XCU. ..3) * 3. ,2. ,2. 0063 

• 0064 

• 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT M=5 0065 

• OUTPUTS - XCU. ..5) * -l.,3.,4.,2.,-l. 0066 

• 0067 

• 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT M=8 0068 

• OUTPUTS - XCU. ..8) = l.,3.,4.,2.,~i.,-2.,0.,0. 0069 

• 0070 

• 4. INPUTS - SAME AS EXAMPLE I. EXCEPT M=l 0071 

• OUTPUTS - XCU) « 7. 0072 

• 0073 

• 5. INPUTS - XU...6) = 1,3,4,2,-1,-2 N=6 TYPE=0. M*2 0074 
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♦ OUTPUTS 


- XCU...2) = 4,3 


0075 


* 






0076 




PZE 




0077 




BCI 


1, COLAPS 


0078 


COLAPS 


sxo 


COLAPS-2,4 


0079 




SXA 


G,l 


0080 




SXA 


G + 1,2 


0081 




CLA* 


3,4 


0082 




TZE 


K 


0083 




CLA 


C2 


0084 




STO 


E 


0085 




TRA 


Al 


0086 


K 


CLA 


CI 


0087 




STO 


E 


0088 


Al 


CLA 


lt4 


0089 




ADO 


D 


0090 




STA 


E 


0091 




CLA 


4,4 


0092 




ADD 


D 


0093 




STA 


C 


0094 




CLA* 


2,4 


0095 




TMI 


G 


0096 




TZE 


G 


0097 




STD 


E+2 


0098 




STD 


C+2 


0099 




CLA* 


5,4 


0100 




TMI 


G 


0101 




TZE 


G 


0102 




STD 


E+l 


0103 




STD 


G-l 


0104 




STD 


B+l 


0105 




AXT 


1,2 


0106 


* BASIC LOOP 




0107 


A 


PXA 


0,2 


0108 




PAX 


0,1 


0109 




CLM 




0110 


E 


NOP 




0111 




TXI 


*+l ,1, ** 


0112 




TXL 


*-2,l,»* 


0113 


C 


STO 


**»2 


0114 




TXI 


♦+1,2,1 


0115 




TXH 


B,2,** 


0116 




TXL 


A, 2,** 


0117 


G 


AXT 


»»tl 


0118 




AXT 


**,2 


0119 




TRA 


6,4 EXIT 


0120 


B 


CLA 


*0 


0121 




TXL 


C,2,»* 


0122 




TRA 


G 


0123 


D 


PZE 


1 


0124 


CI 


ADD 


0,1 


0125 


C2 


FAD 


0,1 


0126 




END 




0127 
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* CONTUR (SUBROUTINE) 9/9/64 LAST CARO IN DECK IS NO. 0641 

* LABEL 0001 
CCONTUR 0002 

SUBROUTINE CONTUR( IT APE, I SENSE* VOFXY,LVX, LVY, LXDIM,FXLO,FXHI , 0003 

1 NCOLS ,NCOLLQ,FYL0, FYHI ,NROWS, ARGLO, ARGDEL, ZFAFXD* 0004 

2 CHLVLSt NCHRSf OELEVLt VLEVLt SPACE t IANS) 0005 
C 0006 
C 0007 

C ABSTRACT 0008 

C 0009 

C TITLE - CONTUR OOiO 

C CONTOUR OF MATRIX SUBSET ON OFF-LINE PRINTER 0011 

C 0012 

C CONTUR CONSIDERS A GIVEN MATRIX AS CONTINUOUS OATA, 0013 

C CONTINUITY AT NON- INTEGRAL INDICES BEING PROVIDED BY 0014 

C CUBIC INTERPOLATION (APPLIED SUCCESSIVELY IN THE TWO 0015 

C DIRECTIONS), AND CONTUR IS ASKED TO CONTOUR AN 0016 

C ARBITRARILY SPECIFIED RECTANGULAR SUBSET OF THE MATRIX 0017 

C INSIDE AN ARBITRARY SIZED RECTANGULAR REGION ON AN 0018 

C OFF-LINE PRINTED OUTPUT PAGE. A GIVEN VECTOR PROVIDES 0019 

C DESIRED CONTOUR LEVELS * OR ALTERNATIVELY THE LEVELS ARE 0020 

C DEFINED BY A GIVEN LEVEL AND AN INCREMENT. THE USER ALSO 0021 

C SPECIFIES THE CHARACTERS USED TO CONTOUR EACH LEVEL* 0022 

C 0023 

C 0024 

C LANGUAGE - FORTRAN-I I SUBROUTINE 0025 

C EQUIPMENT - 709, 7090, 7094 (MAIN FRAME PLUS ONE TAPE UNIT) 0026 

C STORAGE - 587 REGISTERS 0027 

C SPEED - A 120 COLUMN, 150 ROW CONTOUR OF A 25 BY 50 MATRIX TAKES 0028 

C ABOUT 20 SECONDS ON THE 7090. 0029 

C AN 80 COLUMN, 48 ROW CONTOUR OF A 25 BY 25 MATRIX TAKES 0030 

C ABOUT 2 TO 3 SECONDS. 0031 

C AUTHOR - S.M.SIMPSON, MARCH 1964 0032 

C 0033 

C 0034 

C USAGE 0035 

C 0036 

C TRANSFER VECTOR CONTAINS ROUTINES - RNDDN, RNOUP,COL ABL, ARBCOL, 0037 

C CNTR0W,XSAME,SWITCH 0038 

C AND FORTRAN SYSTEM ROUTINES - (STH), (FID, (SPH) 0039 

C 0040 

C FORTRAN USAGE 0041 

C CALL CONTURUTAPE, ISENSE, VOFXY, LVX, LVY, LXDIM,FXLO,FXHI, 0042 

C 1 NCOLS , NCOLLO , FYLO, F YH I , NROWS, ARGLO, ARGDEL * 0043 

C 2 ZFAFXD,CHLVLS, NCHRS, DELE VL,VLEVL, SPACE, IANS) 0044 

C 0045 

C 0046 

C INPUTS 0047 

C 0048 

C I TAPE IS OUTPUT TAPE NO. 0049 

C MUST EXCEED ZERO AND BE LESS THAN 21 . 0050 

C 0051 

C ISENSE PROVIDES AN ON-LINE MONITORING OPTION UNDER SENSE SWITCH 0052 

C CONTROL. IF ISENSE LIES BETWEEN I AND 6 INCLUSIVELY 0053 

C THEN THE OUTPUT APPEARS ON-LINE AS WELL AS OFF-LINE 0054 

C WHILE THE CORRESPONDING SENSE SWITCH IS DOWN. OTHER 0055 

C VALUES OF ISENSE ARE IGNORED. 0056 

C 0057 

C VOFXY(IX,IY) IX*1,2,...,LVX IY= 1,2, . . . , LVY IS THE DATA* PART OR 0058 

C ALL OF WHICH IS TO BE CONTOURED. 0059 

C 0060 

C LVX MUST BE GRTHN= 2 . 0061 

C 0062 

C LVY MUST BE GRTHN* 2 . 0063 

C 0064 

C LXDIM IS THE VALUE TO WHICH IX IN VOFXY(IX,IY) IS DIMENSIONED 0065 

C IN THE CALLING PROGRAM. 0066 

C MUST BE GRTHN= LVX (EQUALS LVX IF MATRIX IS TIGHT PACKED) 0067 

C 0068 

C FXLO IS A FLOATING POINT NUMBER (MAY BE FRACTIONAL) WHICH 0069 

C REPRESENTS THE VALUE OF THE INDEX IX IN VOFXYUX*IY) 0070 

C WHICH IS TO CORRESPOND TO THE LEFTMOST COLUMN IN THE 0071 

C OUTPUT CONTOUR AREA. DATA WITH INDEX IX LESS THAN 0072 

C FXLO IS NOT CONTOURED. 0073 
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C FXLO MUST BE GREATER THAN OR EQUAL TO 1.0 • 0074 

C 0075 

C FXHI SIMILARLY IS THE VALUE OF IX CORRESPONDING TO THE 0076 

C RIGHTMOST OUTPUT COLUMN. DATA WITH INDEX IX 0077 

C GREATER THAN FXHI IS NOT CONTOURED. 0078 

C FXHI MUST BE LESS THAN OR EQUAL TO LVX, AND MUST EXCEED 0079 

C FXLO. 0080 

C 0081 

C NCOLS SPECIFIES HOW MANY COLUMNS THE OUTPUT IS TO OCCUPY. 0082 

C THE COLUMN NUMBERS OCCUPIED BY THE PLOT WILL BE 0083 

C IC0LL0,IC0LL0+1,..., ICOLLO+NCOLS-1 0084 

C WHERE IC0LLO= 7 IF ZFAFXD=0.0» ( SEE 2FAFXD BELOW) 0085 

C =14 IF ZFAFXD NOT =0.0 . 0086 

C MUST BE GRTHN= 2, AND LSTHN= 125 . 0087 

C 0088 

C NCOLLO IS A LABELLING INDEX FOR COLUMN NO. ICOLLO AS DEFINED 0089 

C ABOVE. EACH OUTPUT COLUMN USED WILL BE LABELLED BY 0090 

C A 3-DIGIT INTEGER (EXPRESSED VERTICALLY! STARTING FROM 0091 

C THE INTEGER NCOLLO* AND INDEXED BY UNITY THRU 0092 

C NCOLLO+NCOLS-1 . COLUMN LABELLING IMMEDIATELY 0093 

C PRECEEDS THE FIRST OUTPUT ROW AND FOLLOWS THE LAST 0094 

C OUTPUT ROW. 0095 

C SHOULD BE NON-NEGATIVE AND BE LESS THAN ( 1000-NCOLS) . 0096 

C 0097 

C FYLO IS A FLOATING POINT NUMBER (MAY BE FRACTIONAL) WHICH 0098 

C REPRESENTS THE VALUE OF IY IN VOFXY(IX,IY) WHICH IS 0099 

C TO CORRESPOND TO THE FIRST ROW OF THE PRINTED OUTPUT. 0100 

C DATA WITH INDEX IY LESS THAN FYLO IS NOT CONTOURED. 0101 

C FYLO MUST GRTHN= 1.0 . 0102 

C 0103 

C FYHI SIMILARLY IS THE VALUE OF IY CORRESPONDING TO THE LAST 0104 

C ROW OF PRINTED OUTPUT. DATA WITH INOEX IY GREATER 0105 

C THAN FYHI IS NOT CONTOURED. 0106 

C MUST BE LESS THAN OR EQUAL TO LVY, AND MUST EXCEED FYLO. 0107 

C 0108 

C NROWS SPECIFIES THE NO. OF ROWS THE PRINTED OUTPUT IS TO TAKE. 0109 

C MUST BE GRTHN= 2 . 0110 

C 0111 

C ARGLO IS A FLOATING OR FIXED NUMBER (CORRESPONDING TO THE 0112 

C VARIABLE IY) TO BE PRINTED AT THE LEFTMOST END OF THE 0113 

C FIRST OUTPUT ROW AS A LABEL. MODE IS DETERMINED 0114 

C BY ZFAFXD. 0115 

C 0116 

C ARGDEL IS FLOATING OR FIXED WITH ARGLO, AND IS THE INCREMENT 0117 

C BETWEEN SUCCESSIVE ROWS. 0118 

C 0119 

C ZFAFXD =0.0 IMPLIES ARGLO AND ARGDEL ARE FIXED. 0120 

C NOT =0.0 IMPLIES ARGLO AND ARGDEL ARE FLOATING* FIXED 0121 

C LABELS ARE PRINTED IN F0RMATU6), FLOATING LABELS IN 0122 

C F0RMATIE13.4). 0123 

C 0124 

C CHLVLS(I) 1=1,2, ...,NCHRS GIVES THE CHARACTERS USED FOR PLOTTING 0125 

C THE CONTOUR LEVELS, EACH REGISTER IN FORMAT (Ai). 0126 

C THE CHARACTERS » AND $ SHOULD NOT APPEAR HERE SINCE 0127 

C CNTROW USES THEM TO INDICATE CONFLICT OF CONTOURS. 0128 

C THE RELATION OF CHLVLS TO THE ACTUAL LEVELS DEPENDS 0129 

C ON THE MANNER IN WHICH THE LEVELS ARE DEFINED, AS 0130 

C SPECIFIED BELOW. 0131 

C 0132 

C NCHRS IS THE NO. OF CHARACTERS IN THE CHLVLS VECTOR. IT IS 0133 

C ALSO THE NO. OF CONTOUR LEVELS IN THE CASE 0134 

C DELEVL=0. AS DESCRIBED BELOW. 0135 

C MUST EXCEED ZERO. 0136 

C 0137 

C DELEVL INDICATES THE MANNER OF CONTOUR LEVEL SPECIFICATION. IF 0138 

C DELEVL IS NON-ZERO, SUCCESSIVE CONTOUR LEVELS ARE 0139 

C ASSUMED TO BE SEPARATED BY DELEVL UNITS WITH A 0140 

C STARTING VALUE OF VLEVL (DELEVL MAY NOT BE 0141 

C NEGATIVE). ON THE OTHER HAND IF DELEVL IS ZERO, 0142 

C VLEVL IS INTERPRETED AS A VECTOR GIVING A FIXED SET 0143 

C OF ARBITRARY LEVELS. 0144 

C MUST BE GRTHN= 0.0 . 0145 

C 0146 

C VLEVL(I) I=... HAS INTERPRETATION DEPENDING ON DELEVL. 0147 

C IF DELEVL IS NON-ZERO, VLEVL IS A SINGLE CONSTANT 0148 
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C VLEVL(l), WHICH IS THE CONTOUR LEVEL OF VOFXY TO 0149 

C BE ASSOCIATED WITH THE CHARACTER CHLVLS(l). 0150 

C VLEVL+DELEVL IS TO BE ASSOCIATED WITH CHLVLS<2>, 0151 

C ETC. THIS ASSOCIATION IS TAKEN TO BE CYCLIC IF 0152 

C NECESSARY, I.E., 0153 

C 0154 

C VLEVL+(NCHRS-1)*DELEVL HAS CHARACTER CHLVL SCNCHRSI 0155 

C VLEVL+NCHRS*DELEVL HAS CHARACTER CHLVLSU* 0156 

C ETC. 0157 

C ALSO 0158 

C VLEVL-DELEVL HAS CHARACTER CHLVLS( NCHRS) 0159 

C ETC. FOR LOWER LEVELS. 0160 

C 0161 

C IF DELEVL IS ZERO, VLEVL IS TAKEN AS A VECTOR* 0162 

C VLEVLU...NCHRS), OF INDIVIDUAL CONTOUR LEVELS 0163 

C WHICH CORRESPOND 1 TO 1 WITH THE CHARACTERS OF 0164 

C CHLVLS( 1...NCHRS). THESE CONTOUR LEVELS MUST BE 0165 

C MONOTONELY INCREASING IN SIZE. 0166 

C 0167 

C SPACE(I) I=1...LSPACE IS NEEDED FOR SCRATCH WHERE 0168 

C LSPACE « L ♦ NCOLS «• 3 + XMAXOF t 4,4*NC0LS/L) 0169 

C AND L = (FXHI) ROUNDED UP - (FXLO) ROUNDED DOWN . 0170 

C 0171 

C 0172 

C OUTPUTS NO OUTPUT, OR ONLY PARTIAL OUTPUT OCCURS IF IANS IS NEG. 0173 

C 0174 

C THE PRINCIPAL OUTPUTS OCCUR OFF-LINE ON LOGICAL ITAPE 0175 

C AND POSSIBLY ON-LINE ACCORDING TO ISENSE ANO THE STATUS 0176 

C OF THE SENSE SWITCHES. SEE THE EXAMPLES BELOW FOR 0177 

C ILLUSTRATIONS. THE OUTPUT IS PRECEDED BY A PAGE RESTORE. 0178 

C 0179 

C IANS = 0 NORMALLY 0180 

C = - 1 FOR ILLEGAL ITAPE 0181 

C = - 2 FOR ILLEGAL LVX 0182 

C = - 3 FOR ILLEGAL LVY 0183 

C a - 4 FOR ILLEGAL LXDIM 0184 

C « - 5 FOR ILLEGAL FXLO 0185 

C = - 6 FOR ILLEGAL FXHI 0186 

C = - 7 FOR ILLEGAL NCOLS 0187 

C = - 8 FOR ILLEGAL FYLO 0188 

C » - 9 FOR ILLEGAL FYHI 0189 

C = -10 FOR ILLEGAL NROWS 0190 

C =-105 FOR ILLEGAL NCHRS 0191 

C =-106 FOR ILLEGAL DELEVL 0192 

C =-107 FOR ILLEGAL VLEVL (NOT MONOTONE IN CASE DELEVL=0.) 0193 

C (THE LAST THREE ILLEGALITIES BEING CAUGHT BY 0194 

C SUBROUTINE CNTROW) 0195 

C 0196 

C 0197 

C EXAMPLES 0198 

C THE FIRST 6 EXAMPLES BELOW CONTOUR DATA REPRESENTING A 0199 

C SIMPLE PLANE, WITH CONSTANT VALUES IN THE IY DIRECTION. 0200 

C THEY WILL UTILIZE MATRICES DEFINED AS FOLLOWS. 0201 

C 0202 

C DIMENSION V0FXY(4,4),VXY22(4,2),VXY23(4,3),VXY24(4,4) , 0203 

C 1 VXY32(4,2),VXY42(4,2),VXY33(4,3},SPACE(152) 0204 

C VXY22(1...2,,IY) = 0.0,10.0 FOR IY*1,2 0205 

C VXY23( 1...2,,IY) = 0.0,10.0 FOR IY*1,2,3 0206 

C VXY24(1...2,,IY) » 0.0,10.0 FOR IY*H2,3,4 0207 

C VXY32(1*..3,,IY) = 0.0,5.0,10.0 FOR IY*1,2 0208 

C VXY42(1...4,,IY) = 0.0,3.333333,6.666667,10.0 FOR IY*1,2 0209 

C VXY33(1...3,,IY) = 0.0,5.0,10.0 FOR IY=1,2,3 0210 

C CHLVLSU...20) = 1H0, 1H1, 1H2, . . . , 1H9, 1HA, 1HB, ..i , 1HJ 0211 

C 0212 

C 1. INPUTS - ITAPE=2 ISENSE=1 V0FXY=VXY22 DEFINED ABOVE 0213 

C LVX=2 LVY=2 LXDIM=4 FXL0=1.0 FXHI=2.0 0214 

C NC0LS=21 NCOLLO=0 FYL0=1. FYHI=2. NR0WS=2 0215 

C ARGLO=0. ARGDEL=1. ZFAFXD=1. NCHRS=20 0216 

C DELEVL=1.0 VLEVL=0.0 0217 

C USAGE - CALL CONTUR( ITAPE, I SENSE, VOFXY, LVX, LVY, LXDIM, 0218 

C 1 FXLO, FXHI, NCOLS, NCOLLO, FYLO, FYHi, 0219 

C 2 NROWS, ARGLO, ARGDEL,ZFAF XD, CHLVL S, 0220 

C 3 NCHRS, DELEVL, VLEVL, SPACE, IANS) 0221 
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C OUTPUTS - IANS*0 AND THE PRINTED OUTPUT WILL BE < ENDING *N COL. 34) 0222 

C 0223 

C 000000000000000000000 0224 

C 000000000011111111112 0225 

C 012345678901234567890 0226 

C 0* 0123456789A 0227 

C 0.10006 010 123456789A 0228 

C 000000000000000000000 0229 

C 000000000011111111112 0230 

C 012345678901234567890 0231 

C 0232 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT V0FXY=VXY23t LVX*2t FXHI*2.0, 0233 

C LVY=3, FYHI*3«0, NR0WS=2 0234 

C USAGE - SAME AS EXAMPLE 1. 0235 

C OUTPUTS - IDENTICAL TO EXAMPLE 1. 0236 

C 0237 

C 3. INPUTS - SAME AS EXAMPLE I. EXCEPT V0FXY=VXY24, LVX*2, FXHI=2.0, 0238 

C LVY=4, FYHI=4.0, NR0WS=3 0239 

C USAGE - SAME AS EXAMPLE 1. 0240 

C OUTPUTS - IANS=0 AND THE PRINTED OUTPUT IS 0241 

C 0242 

C 000000000000000000000 0243 

C 000000000011111111112 0244 

C 012345678901234567890 0245 

C 0. 0123456789A 0246 

C 0.1000E 010 123456789A 0247 

C 0.2000E 010 1 2 3 4 5 6 7 8 9 A 0248 

C 000000000000000000000 0249 

C 000000000011111111112 0250 

C 012345678901234567890 0251 

C 0252 

C 4, INPUTS - SAME AS EXAMPLE 1. EXCEPT V0FXY=VXY32, LVX*3, FXHI*3«0, 0253 

C LVY=2, FYHI=2.0, NR0WS=4 0254 

C USAGE - SAME AS EXAMPLE 1. 0255 

C OUTPUTS - IANS=0 AND THE PRINTED OUTPUT IS 0256 

C 0257 

C 000000000000000000000 0258 

C 000000000011111111112 0259 

C 012345678901234567890 0260 

C 0. 0123456789A 0261 

C 0.1000E 010 123456789A 0262 

C 0.2000E 010 123456789A 0263 

C 0.3000E 010 1 2 3 4 5 6 7 8 9 A 0264 

C 000000000000000000000 0265 

C 000000000011111111112 0266 

C 012345678901234567890 0267 

C 0268 

C 5. INPUTS - SAME AS EXAMPLE 1. EXCEPT V0FXY*VXY42» LVX*4, FXHI=4.0, 0269 

C LVY=2, FYHI=2.0, NR0WS=5 0270 

C USAGE - SAME AS EXAMPLE 1. 0271 

C OUTPUTS - IANS=0 AND THE PRINTED OUTPUT IS 0272 

C 0273 

C 000000000000000000000 0274 

C 000000000011111111112 0275 

C 012345678901234567890 0276 

C 0. 0123456789A 0277 

C 0.1000E 010 1 2 3 4 5 6 7 8 9 A 0278 

C 0.2000E 010 123456789A 0279 

C 0.3000E 010 1 2 3 4 5 6 7 8 9 A 0280 

C 0.4000E 010 123456789 A 0281 

C 000000000000000000000 0282 

C 000000000011111111112 0283 

C 012345678901234567890 0284 

C 0285 

C 6. INPUTS - SAME AS EXAMPLE 1. EXCEPT V0FXY=VXY33, LVX*3, FXHI=3*0, 0286 

C LVY=3, FYHI*3.0, NR0WS=6 0287 

C USAGE - SAME AS EXAMPLE 1. 0288 

C OUTPUTS - IANS=0 AND THE PRINTED OUTPUT IS 0289 

C 0290 

C 000000000000000000000 0291 

C 000000000011111111112 0292 

C 012345678901234567890 0293 

C 0. 0 12345678 -9 A 0294 

C 0.1000E 010 123456789A 0295 

C 0.2000E 010 123456789A 0296 
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0.3000E 010 1 2 3 4 5 6 7 8 9 A 


0297 


c 


0.4000E 010 123456789A 


0298 


Q 


0,5000b 010 1 2 3 4 5 6 7 8 9 A 


0299 


Q 




000000000000000000000 


0300 






000000000011111111112 


0301 






012345678901234567890 


0302 


Q 






0303 


C 7. 


FOR EXAMPLES 7., 8., AND 9,, WE SHALL CONTOUR A 1/R TYPE FUNCTION. 


0304 








0305 


c 


INPUTS - SAME AS EX. 1. EXCEPT VOFXY SHOULD BE SET UP AS FOLLOWS. 


0306 






DIMENSION VOFXYt 25,25) 


0307 


Q 




DO 10 1X^1,25 


0308 


c 




DO 10 IY=1,25 


0309 


c 




R-SQRTF ( FLOAT F ( { IX-l)»*2+< IY-1)»»2) ) 


0310 


c 




VOFXYt IX, IY)=20.0/{R+.5) 


031 1 


c 


AND 


SET LVX=LVY=LXDIM=25, FXHI^FYHI =25. 0, NC0LS*80, 


0312 


c 




NR0WS=48 <THIS RATIO OF NCOLS/NROWS MAPS CIRCLES 


0313 


Q 




INTO CIRCLES.) 


0314 








0315 


c 


USAGE - SAME AS EXAMPLE I. 


0316 


Q 


OUTPUTS - IANS=0 AND THE FIRST 64 COLUMNS OF PRINTED OUTPUT ARE 


0317 


c 






0318 


c 




000000000000000000000000000000000000000000000000000 


0319 






00000000001111 1111112222222222333333333344444444445 


0320 


c 




012345678901234567890123456789012345678901234567890 


0321 




0. 


$$$$$9 876 5 4 3 2 


0322 




0. 1000E 


01$$$$*987 6 5 4 3 2 


0323 


c 


0.2000E 


01DC BA987 6 5 4 3 2 


0324 


c 


0.3000E 


019 9 87 6 5 4 3 2 


0325 


c 


0.4000E 


01 7 6 5 4 3 2 


0326 


c 


0.5000E 


01 6 5 4 3 2 


0327 


c 


0.6000E 


01 5 4 3 2 


0328 




0.7000E 


01 4 3 2 


0329 




0.8000E 


01 4 3 2 


0330 


c 


0. 9000E 


01 3 2 


0331 




0. 1000E 


02 3 2 


0332 


Q 


0. 1100E 


02 3 2 


0333 


c 


0. 1200E 


02 3 2 


0334 


c 


0. 1 300E 


02 2 


0335 




0. 1400E 


02 2 


0336 




0. 1500E 


02 2 


0337 




0- 1600E 


02 2 


0338 




0. 1700E 


02 2 


0339 


c 


0.1800E 


02 2 


0340 


c 


0.1900E 


02 


0341 


c 


0.2000E 


02 


0342 


c 


0.2100E 


02 


0343 


c 


0.2200E 


02 


0344 


c 


0.2300E 


02 


0345 


c 


0.2400E 


02 1 


0346 


c 


0.2500E 


02 1 


0347 


c 


0.2600E 


02 1 


0348 


c 


0.2700E 


02 1 


0349 


c 


0.2800E 


02 1 


0350 


c 


0.2900E 


02 1 


0351 


c 


0.3000E 


02 I 


0352 


c 


0.3100E 


02 1 


0353 


c 


0.3200E 


02 1 


0354 


c 


0.3300E 


02 1 


0355 


c 


0.3400E 


02 1 


0356 


c 


0.3500E 


02 1 


0357 




0.3600E 


02 1 


0358 




0.3700E 


02 1 


0359 


c 


0.3800E 


02 1 


0360 


c 


0.3900E 


02 


0361 


c 


0.4000E 


02 


0362 


c 


0.4100E 


02 


0363 


c 


0.4200E 


02 


0364 


c 


0.4300E 


02 


0365 


c 


0.4400E 


02 


0366 


c 


0.4500E 


02 


0367 


c 


0.4600E 


02 


0368 


c 


0.4700E 


02 


0369 


c 




000000000000000000000000000000000000000000000000000 


0370 


c 




000000000011111111112222222222333333333344444444445 


0371 
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THIS EXAMPLE IS THE SAME AS EXAMPLE 7. EXCEPT THAT WE USE ONLY 

THE UPPER LEFT CORNER OF THE DATA. 
INPUTS - SAME AS EXAMPLE 7. EXCEPT FXHI=FYHI=10. 
USAGE - SAME AS EXAMPLE I. 

OUTPUTS - IANS^O AND THE FIRST 64 COLUMNS OF PRINTED OUTPUT ARE 

000000000000000000000000000000000000000000000000000 
000000000011111111112222222222333333333344444444445 
012345678901234567890123456789012345678901234567890 



9. 



0. 

0.1000E 
0.2000E 
0.3000E 
0.4000E 
0.5000E 
0.6000E 
0.7000E 
0.8000E 
0.9000E 
0.1000E 
0.1100E 
0.1200E 
0.1300E 
0.1400E 
0.1500E 
0.1600E 
0.1700E 
0.1800E 
0.1900E 
0.2000E 
0.2100E 
0.2200E 
0.2300E 
0.2400E 
0.2500E 
0.2600E 
0.2700E 
0.2800E 
0.2900E 
0.3000E 
0.3100E 
0.3200E 
0.3300E 
0.3400E 
0.3500E 
0.3600E 
0.3700E 
0.3800E 
0.3900E 
0.4000E 
0.4100E 
0.4200E 
0.4300E 
0.4400E 
0.4500E 
0.4600E 
0.4700E 



$$$$$$»*$DCBA 9 8 7 6 5 4 

01$$$*$***EDC8A 9 8 7 6 5 4 

01»»$1»«G*DCB A 9 8 7 6 5 4 

012*JI»FEDC BA9876 5 4 

01IHGFE DC B A 9 8 7 6 5 4 

01EDCBA9876 5 4 

BA9876 5 4 

A 9 8 7 6 5 4 

9 8 7 6 5 4 



01 
01 
019 
01 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
02 
0? 
02 
02 
02 
02 
02 



8 



8 



000000000000000000000000000000000000000000000000000 
000000000011111111112222222222333333333344444444445 
012345678901234567890123456789012345678901234567890 

THIS EXAMPLE IS THE SAME AS EXAMPLE 7. EXCEPT THAT WE USE ONLY AN 

INTERNAL SQUARE OF THE DATA. 
INPUTS - SAME AS EXAMPLE 7. EXCEPT FXL0=FYL0=5. , FXHI=FYHI*10. 0 
USAGE - SAME AS EXAMPLE 1. 

OUTPUTS - IANS=0 AND THE FIRST 64 COLUMNS OF PRINTED OUTPUT ARE 

OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOQOOOOOOOOOO 
000000000011111111112222222222333333333344444444445 
012345678901234567890123456789012345678901234567890 

2 

2 

2 



0. 

0.1000E 01 
0.2000E 01 
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0372 
0373 
0374 
0375 
0376 
0377 
0378 
0379 
0380 
0381 
0382 
0383 
0384 
0385 
0386 
0387 
0388 
0389 
0390 
0391 
0392 
0393 
0394 
0395 
0396 
0397 
0398 
0399 
0400 
0401 
0402 
0403 
0404 
0405 
0406 
0407 
0408 
0409 
0410 
0411 
0412 
0413 
0414 
0415 
0416 
0417 
0418 
0419 
0420 
0421 
0422 
0423 
0424 
0425 
0426 
0427 
0428 
0429 
0430 
0431 
0432 
0433 
0434 
0435 
0436 
0437 
0438 
0439 
0440 
0441 
0442 
0443 
0444 
0445 
0446 
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c 


0- 3000E 


01 2 


0447 


c 


0.4000E 


01 2 


0448 


c 


0.5000E 


01 2 


0449 


c 


0.60006 


01 2 


0450 


c 


0.7000E 


01 2 


0451 


c 


0.8000E 


01 2 


0452 


c 


0.9000E 


01 2 


0453 


c 


0* 1000E 


02 2 


0454 


c 


0. 1 100E 


02 2 


0455 


c 


0. 1200E 


02 2 


0456 


c 


0« 1 300E 


02 2 


0457 


c 


0. 1400E 


02 2 


0458 


c 


0. 1500E 


02 2 


0459 


c 


0. 1600E 


02 


0460 


c 


Q» 1700E 


02 


0461 


c 


0. 1800E 


02 


0462 


c 


0» 1900E 


02 


0463 


c 


0.2000E 


02 


0464 


c 


0.2100E 


02 


0465 


c 


0« 2200E 


02 


0466 


c 


0.2300E 


02 


0467 


c 


0. 2400E 


02 


0468 


c 


0. 2500E 


02 


0469 


c 


U.ZoUUfc 


02 


0470 


c 


0.2700E 


02 


0471 


c 


0.2800E 


02 


0472 


c 


0.2900c 


02 


0473 


c 


0.3000E 


02 


0474 


c 


0. 3100E 


02 


0475 


c 


0. 3200E 


02 


0476 


c 


0« 3300E 


02 


0477 


c 


0.3400E 


02 


0478 


c 


0-3500E 


02 


0479 


c 


0. 3600E 


02 


0480 


c 


0*3700E 


02 


0481 


c 


0. 3800E 


02 


0482 


c 


0.3900E 


02 


0483 


c 


0«4000E 


02 


0484 


c 


0-4100E 


02 


0485 


c 


0.4200E 


02 


0486 


c 


0.4300E 


02 


0487 


c 


0.4400E 


02 


0488 


c 


0.4500E 


02 


0489 


c 


0.4600E 


02 


0490 


c 


0.4700E 


02 


0491 


c 




000000000000000000000000000000000000000000000000000 


0492 


c 




000000000011111111112222222222333333333344444444445 


0493 


c 




012345678901234567890123456789012345678901234567890 


0494 


c 






0495 


c 






0496 


c 


PROGRAM FOLLOWS BELOW 


0497 


c 






0498 


c 


DUMMY DIMENSIONS 




0499 


c 






0500 




DIMENSION 


V0FXY (2 ) fCHLVLS ( 2) , VLEVL ( 2) ♦ SPACE( 2) 


0501 


c 






0502 


c 


TRUE DIMENSIONS 




0503 


c 






0504 




DIMENSION FMT ( 3 ) 


0505 




EQUIVALENCE 


URG, IARG) 


0506 


c 






0507 


c 


BRING IN SOME OFTEN USED ARGUMENTS 


0508 


c 






0509 




ITP=ITAPE 




0510 




LX=LVX 




051 1 




LY-LVY 




0512 




LX0M=LXDIM 




0513 




FXL^FXLO 




0514 




FXH=FXHI 




0515 




NCLS'NCOLS 




0516 




NCLL0=XABSF(NC0LL0) 


0517 




FYL=FYL0 




0518 




FYH=FYHI 




0519 




NRWS=NR0WS 




0520 


c 






0521 
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SET 


A FEW PRELIMINARY CONSTANTS 






0522 










0523 




I XLO-RNDDNF ( FXL ) 






0524 




IXHI=RNDUPF(FXH) 






0525 




I YLO-RNDDNF (FYL) 






0526 




IYHI=RNDUPF ( FYH) 






0527 










0528 


CHECK I TAPE,LVX,LVY,LXDIM,FXLO,FXHI ,NCOLS»FYLO, 


FYHI 


,NROWS. 


0529 










0530 




IANSR=-l 






0531 




IF (ITP) 9999,9999,5 






0532 


5 


IF (ITP-20) 10,10,9999 






0533 


10 


I ANSR=~2 






0534 




IF (LX-l) 9999,9999,20 






0535 


20 


I ANSR=-3 






0536 




IF (LY-1) 9999,9999,30 






0537 


30 


IANSR=-4 






0538 




IF (LXDM-LX) 9999,40,40 






0539 


40 


I ANSR=-5 






0540 




IF (IXLO) 9999,9999,50 






0541 


50 


IANSR=-6 






0542 




IF (IXHl-IXLO) 9999,9999,55 






0543 


55 


IF (IXHI-LX) 60,60,9999 






0544 


60 


I ANSR=-7 






0545 




IF (NCLS) 9999,9999,65 






0546 


65 


IF (NCLS-125) 70,70,9999 






0547 


70 


I ANSR=-8 






0548 




IF (IYLO) 9999,9999,80 






0549 


80 


IANSR--9 






0550 




IF (IYHI-IYLO) 9999,9999,85 






0551 


85 


IF (IYHI-LY) 90,90,9999 






0552 


90 


IANSR=-10 






0553 




IF (NRWS ) 9999,9999,100 






0554 










0555 


GIVE PAGE RESTORE AND THE COLUMN INDICATOR 






0556 










0557 


100 


WRITE OUTPUT TAPE ITP, 105 






0558 


105 


FORMAT ( IH1 ) 






0559 










0560 


SET 


UP THE REMAINING CONSTANTS 






0561 










0562 




I XLOR^XMAXOF ( 1 , IXLO- 1 ) 






0563 




IXHIR=XMIN0F( IXHI+1,LX) 






0564 




LVEC=IXHIR-IXLOR+l 






0565 




I YL0R=XMAX0F ( 1, I YLO-1 ) 






0566 




IYHIR=XMIN0F( IYHI+1,LY) 






0567 




DIFF-FLOATF( IXLOR-l) 






0568 




FXL02«FXL-DIFF 






0569 




FXHI2=FXH-DIFF 






0570 




ISPVEC^l 






0571 




ISPPLT=ISPVEC+LVEC 






0572 




ISPPND=ISPPLT+NCLS-1 






0573 




ISPSPA=ISPPLT+NCLS 






0574 




ClFY=0.0 






0575 




IF (NRWS-1) 115,115,110 






0576 


110 


CIFY= ( FYH-FYL ) /FLOAT F ( NRWS-1 ) 






0577 


115 


CZFY=FYL-C1FY 






0578 




FMT(1)=6HU6,13 






0579 




FMT(2)=4H0A1) 






0580 




IC0LL0«7 






0581 




IF UFAFXD) 120,130,120 






0582 


120 


FMT( 1 )-6H(E13«4 






0583 




FMT(2)=6H, 130A1 






0584 




FMT(3)=1H) 






0585 




IC0LL0=14 






0586 


130 


ARG= ARGLO 






0587 




IXROW=l 






0588 




CALL COLABLt ITP, ICOLLO,NCLLO, NCLS, SPACE) 






0589 










0590 


FIND THE UNROUNDED INDEX, FY, CORRESPONDING TO 


THIS 


ROW IXROW 


0591 




(SPECIAL TREATMENT FOR IXR0W=1 AND =NRWS IS 


TO 


AVOID 


0592 




ROUNDOFF UNCERTAINTIES) 






0593 










0594 


300 


IF (IXROW-1) 305,305,310 






0595 


305 


FY-F YL 






0596 



••*••*•*•**••»*•••*»»»»• PROGRAM LISTINGS #*•*•*»*«••*»*•#***»••«• 

* CONTUR * « CONTUR • 
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GO TO 330 0597 

310 IF (IXROW-NRWS) 320,315,315 0598 

315 FY=FYH 0599 

GO TO 330 0600 

320 FY=CZFY+C1FY»FL0ATF( IXROW) 0601 

C 0602 

C INTERPOLATE THE COLUMN WHOSE INDEX IS FY 0603 

C 0604 

330 NY » IYHIR-IYLOR+1 0605 

IXV = IXL0R+UYL0R-1)»LXDM 0606 

CALL ARBCOL( VOFXYUXV),LVEC,NY,LXDM,FY,SPACE( ISPVECf) 0607 

C 0608 

C CONTOUR SPACEUSPVECf.. ) INTO SPACE( ISPPLT ) AND CHECK IANS. 0609 

C 0610 

700 CALL CNTROW(SPACE( ISPVEC),LVEC,FXL02,FXHI2,NCLS,CHLVLS,NCHRS, 0611 

1 DELE VL fVLEVLt SPACE ( ISPSPA ) , SPACE! ISPPLT 1 1 1 ANSR) 0612 

IF (IANSR) 720*730,720 0613 

720 IANSR*IANSR-100 0614 

GO TO 9999 0615 

C 0616 

C PRINT THE OUTPUT OFF-LINE FIRST, THEN ON-LINE IF REQUESTED 0617 

C 0618 

730 WRITE OUTPUT TAPE ITP,F MT, ARG, { SPACE ( I ) , 1*1 SPPLT, ISPPNDI 0619 

IF (SWITCHF(ISENSE)) 770,770,760 0620 

760 PRINT FMT,ARG,(SPACE(I),I=ISPPLT,ISPPND) 0621 

C 0622 

C THEN INCREMENT ARG (= I ARG) , IXROW, AND CHECK FOR FINISH; 0623 

C 0624 

770 IF (ZFAFXD) 780,790,780 0625 

780 ARG^ARG+ARGDEL 0626 

GO TO 795 0627 

790 I ARG=I ARG+XSAMEF ( ARGDEL ) 0628 

795 IXR0W*IXR0W+1 0629 

IF (IXROW-NRWS) 300,300,800 0630 

C 0631 

C BEFORE RETURNING, REOUTPUT THE COLUMN LABELLING 0632 

C 0633 

800 CALL COLABL(ITP,ICOLLO,NCLLO,NCLS, SPACE) 0634 

IANSR=0 0635 

C 0636 

C EXIT 0637 

C 0638 

9999 IANS=IANSR 0639 

RETURN 0640 

END 0641 



* CONVLV » 
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# CONVLV * 
#»»#*«••••*»*•»•**•»*•»• 



» CONVLV ( SUBROUTINE ) 9/29/64 LAST CARO IN DECK IS NO. 0098 

♦ LABEL 0001 

CCONVLV 0002 
SUBROUTINE CONVLVILX, XX,LY,YY,CC ) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - CONVLV 0007 

C COMPLETE CONVOLUTION OF TWO TRANSIENTS 0008 

C 0009 

C CONVLV CONVOLVES TWO TRANSI ENTS, X(I) 1*0, I, .. . ,LX-l 0010 

C AND Yd) I=0,l,...,LY-l , TO PRODUCE THE COMPLETE 0011 

C CONVOLUTION FUNCTION 0012 

C 0013 

C LX-1 0014 

C C(I> = SUM ( X(J)*Y(I-J) ) 0015 

C J=0 0016 

C 0017 

C FOR I * Of It LX+LY-2 0018 

C WHERE 0019 

C LX AND LY ARE INPUT PARAMETERS 0020 

C Y ( K) IS ASSUMED * 0.0 FOR K OUTSIDE OF 0021 

C THE RANGE 0 TO LY-l 0022 

C NOTE THAT THE CONVOLUTION IS INDEPENDENT OF THE ORDER 0023 

C OF THE INPUTS X AND Y. 0024 

C 0025 

C TECHNIQUE USED IS AN ALGORITHM BASED ON ANALOGY TO 0026 

C MULTIPLICATION OF POLYNOMIALS 0027 

C 0028 

C LANGUAGE - FORTRAN II SUBROUTINE 0029 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0030 

C STORAGE - 96 REGISTERS 0031 

C SPEED - ABOUT .49 « (LX»LY) MILLISEC ON THE 709 0032 

C ABOUT .082 * ( LX*LY ) MILLISEC ON THE 7090 0033 

C AUTHOR - J. CLAERBOUT 0034 

C 0035 

C USAGE 0036 

C 0037 

C TRANSFER VECTOR CONTAINS ROUITNES - (NONE) 0038 

C AND FORTRAN SYSTEM ROUTINES - (NONE) 0039 

C 0040 

C FORTRAN USAGE 0041 

C CALL CONVLV(LX f XX, LY,YY, CO 0042 

C 0043 

C INPUTS 0044 

C 0045 

C LX IS NO. OF TERMS IN X VECTOR 0046 

C MUST EXCEED ZERO (PROGRAM EXITS IF ZERO OR LESS) 0047 

C 0048 

C XXU) I*lt....LX CONTAINS X( 0 ),..., X( LX-1 ) RESPECTIVELY 0049 

C 0050 

C LY IS NO. OF TERMS IN Y VECTOR 0051 

C MUST EXCEED ZERO (PROGRAM EXITS IF ZERO OR LESS) 0052 

C 0053 

C YYII) 1=1. ..LY CONTAINS Y( 0 ) * • • • , Y( LY— I ) RESPECTIVELY 0054 

C EQUIVALENCE (XX, YY) IS PERMITTED 0055 

C 0056 

C OUTPUTS 0057 

C 0058 

C CC(I) I=1,...,LX+LY-1 CONTAINS C ( 0) t . . . tC ( LX+LY-2 ) RESPECTIVELY 0059 

C WHERE C(I) IS GIVEN IN ABSTRACT 0060 

C 0061 

C EXAMPLES 0062 

C 0063 

C 1. SHOWING REVERSIBILITY OF X AND Y 0064 

C INPUTS — LX = 3 XXU...3) * l.,2.,3. 0065 

C LY « 2 YY(l...2) * 10., 1. 0066 

C 0067 

C USAGE - CALL CONVLV(LX,XX,LY,YY, CCl ) 0068 

C CALL C0NVLV(LY,YY,LX,XX,CC2) 0069 

C OUTPUTS - CCK1...4) * CC2U...4) » 10., 21. , 32., 3. 0070 

C 0071 

C 2. ILLEGAL INPUT CASES (NO OUTPUT) 0072 

C INPUTS ~ SAME AS EXAMPLE 1. EXCEPT START WITH OUTPUT VECTORS 0073 

C CLEANED, I.E. CCK1...4) » CC2U...4) = 0.,0.,0.,0. 0074 



*•»*•»•»•«•*•*»**»*»*** 
CONVLV * 
••#**»»•«••••»»»»»»••** 
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CONVLV • 
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USAGE - CALL CONVLV ( -2 , XX , LY , YY.CCl ) 

CALL CONVLV(LX,XX,0,YY,CC2) 

OUTPUTS - CC1U...4) = O.tO.tO.tO. (ILLEGAL LX ) 

CC2(1.*.4) * 0.,0.,0«,0. (ILLEGAL LY ) 

PROGRAM FOLLOWS BELOW 



DUMMY DIMENSION STATEMENTS 

DIMENSION XX(2) ,YY(2),CC(2) 
CHECK LEGALITIES 

IF (LX) 9999,9999,10 
10 IF (LY) 9999,9999,20 
CLEAR OUTPUT VECTOR 
20 LC=LX+LY-1 

DO 30 1=1, LC 
30 CC(I)=0.0 
CONVOLVE 

DO 40 1=1, LX 
DO 40 J=1,LY 
K=I+J 

40 CC ( K-l ) =CC ( K-l ) +XX ( I ) «YY ( J ) 
EXIT 
9999 RETURN 
END 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 



»»*•»*••*•«»«»*•»*»• PROGRAM LISTINGS #»»*•*»»##»**♦« 

CONVLV-II » « CONVLV-II 



« CONVLV-II (SUBROUTINE) 10/2/64 LAST CARD IN DECK IS NO* 0148 

* FAP 0001 
♦CONVLV-II 0002 

COUNT 125 0003 

LBL CONVLV 0004 

ENTRY CONVLV (LX, XX, LY,YY,CC) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - CONVLV-II 0009 
» COMPLETE CONVOLUTION OF TWO TRANSIENTS 0010 

* 0011 

* CONVLV-II CONVOLVES TWO TRANSIENTS X(I) 1=0* 1 , . * . ,LX-1 0012 

* AND Yd) 1=0,1,..., LY-l f TO PRODUCE THE COMPLETE 0013 

* CONVOLUTION FUNCTION 0014 

* 0015 

* LX-i 0016 

* CU) = SUM ( X(J)*Y(I-J) ) 0017 
» J=0 0018 

* 0019 

* FOR I =» 0,1,..., LX+LY-2 0020 

* WHERE 0021 
» LX AND LY ARE INPUT PARAMETERS 0022 

* Y(K) IS ASSUMED * 0.0 FOR K OUTSIDE OF 0023 

* THE RANGE 0 TO LY-l 0024 

* NOTE THAT THE CONVOLUTION IS INDEPENDENT OF THE ORDER 0025 

* OF THE INPUTS X AND Y. 0026 

* 0027 

* CONVLV-II IS A FAP PROGRAM FUNCTIONALLY IDENTICAL TO THE 0028 

* FORTRAN PROGRAM CONVLV BUT IS ABOUT 35 PERCENT FASTER* 0029 

* 0030 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0031 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0032 

* STORAGE - 56 REGISTERS 0033 

* SPEED - ABOUT .32 * ( LX»LY ) MILLISEC ON 709 0034 

* .051 * ( LX*LY ) MILLISEC ON 7090 0035 
» AUTHOR - J. CLAERBOUT AND R. WIGGINS 0036 

* 0037 

* USAGE 0038 

* 0039 

* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0040 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0041 

* 0042 

* FORTRAN USAGE 0043 
» CALL CONVLV( LX , XX, LY , YY , CC ) 0044 

* 0045 

* INPUTS 0046 
« 0047 
» LX IS NO. OF TERMS IN X VECTOR 0048 
» FOR MAXIMUM SPEED THE X VECTOR SHOULD BE THE LONGEST 0049 

* IF X AND Y HAVE DIFFERENT LENGTHS 0050 

* MUST EXCEED ZERO (PROGRAM EXITS IF ZERO OR LESS) 0051 

* 0052 

* XX(I) 1=1,... ,LX CONTAINS X< 0 ),..., X ( LX-1) RESPECTIVELY 0053 

* 0054 
« LY IS NO. OF TERMS IN Y VECTOR 0055 

* MUST EXCEED ZERO (PROGRAM EXITS IF ZERO OR LESS) 0056 

* 0057 

* YY(I) 1=1.. .LY CONTAINS Y(0) , .. . ,Y( LY-l) RESPECTIVELY 0058 

* EQUIVALENCE <XX,YY) IS PERMITTED 0059 

* 0060 

* OUTPUTS 0061 

* 0062 
» CCU) 1=1,... ,LX+LY-1 CONTAINS C ( 0) , . . . ,C ( LX+LY-2 ) RESPECTIVELY 0063 

* WHERE C(I) IS GIVEN IN ABSTRACT 0064 

* 0065 
» EXAMPLES 0066 

* 0067 

* 1. SHOWING REVERSIBILITY OF X AND Y 0068 

* INPUTS - LX = 3 XXU...3) = l.,2.,3. 0069 
» LY = 2 YYU...2) = 10., 1. 0070 

* 0071 

* USAGE - CALL CONVLV ( LX ,XX , LY, YY , CC I ) 0072 
» CALL C0NVLV{LY,YY,LX,XX,CC2) 0073 



» CONVLV-II 



PROGRAM LISTINGS 



* CONVLV-II 
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» 


OUTPUTS - 


CCH1...4) * 


CC2U...4) * 10. ,21. ,32., 3. 


0074 


* 








0075 


* 2. 


ILLEGAL INPUT GASES ( NO OUTPUT) 


0076 


• 


INPUTS - 


SAME AS EXAMPLE I. EXCEPT START WITH OUTPUT VECTORS 


0077 


* 




CLEANED, I. 


E. CCH1...4) = CC2U...4) = 0.,0.,0.,0. 


0078 


• 


USAGE 


CALL CONVLV(-2,XX,LY,YY,CCl) 


0079 


• 




CALL CONVLV(LX,XX,0,YY,CC2) 


0080 


» 


OUTPUTS - 


CCH1...4) = 


0.,0.,0.,0. (ILLEGAL LX ) 


0081 


• 




CC2U...4) « 


0.,0.,0.,0. ( ILLEGAL LY ) 


0082 


• 








0083 


* PROGRAM FOLLOWS BELOW 




0084 


» IN 


I PROGRAM 


NOTES BELOW 




0085 


• 


X=XX 






0086 


• 


Y-YY 






0087 


# 


OCC 






0088 




HTR 


0 




0089 




HTR 


0 




0090 




HTR 


0 




0091 




BCI 


1 , CONVLV 




0092 


CONVLV SXD 


CONVLV-4, I 




0093 




SXD 


CONVLV-3,2 




0094 




SXD 


CONVLV-2,4 




0095 




CLA* 


1,4 


GET AND SET UP 


0096 




ARS 


18 




0097 




STA 


LADI 


LENGTH OF X SERIES. 


0098 




TMI 


LEAVE 




0099 




TZE 


LEAVE 




0100 




CLA* 


3,4 


GET AND SET UP 


0101 




ARS 


18 


LENGTH OF 


0102 




STA 


LAD2 


Y SERIES. 


0103 




TMI 


LEAVE 




0104 




TZE 


LEAVE 




0105 




CLA 


2,4 


SET 


0106 




ADD 


= 1 


UP 


0107 




STA 


S2 


ADDRESS. 


0108 




CLA 


4,4 


SET 


0109 




ADD 


= 1 


UP 


0110 




STA 


Si 


ADDRESS. 


0111 




CLA 


5,4 


SET UP 


0112 




SUB 


LAD2 


ADDRESS 


0113 




ADD 


=2 


EQUAL TO 


0114 




STA 


S3 


LOCtCl-LY+2. 


0115 




STA 


S4 




0116 




CLA 


5,4 




0117 




ADD 


= 1 




0118 




STA 


Z 


= BES C 


0119 




CLA 


LADI 




0120 




ADD 


LAD2 




0121 




SUB 


= 1 




0122 




PAX 


,1 


LC=LX+LY-1 GOES TO XR1 


0123 


• 


FILL 


ANSWER BLOCK 


WITH ZEROS 


0124 


Z 


STZ 






0125 




TIX 


•-1,1,1 




0126 




LXA 


LAD2,2 




0127 


* 


OUTER 


LOOP 




0128 


S 


LXA 


LADI, I 




0129 


» 


CENTRAL 


LOOP 




0130 


SI 


LDQ 


**,2 


**=8ES Y 


0131 


S2 


FMP 


**, 1 


**=BES X 


0132 


S3 


FAD 


**, 1 


*»*BES C -LY+1 (INITIALLY) 


0133 


S4 


STO 


»»,1 


*»=BES C -LY+1 (INITIALLY) 


0134 




TIX 


SI, 1,1 




0135 


• 


END CENTRAL LOOP 




0136 




CLA 


S3 


RESET CENTRAL 


0137 




ADD 


= 1 


LOOP FOR 


0138 




STA 


S3 


THE NfcXT 


0139 




STA 


S4 


LAG. 


0140 




TIX 


S,2,l 




0141 


* 


END OF 


OUTER LOOP 




0142 


LEAVE LXD 


CONVLV-4, 1 




0143 




LXD 


CONVLV-3,2 




0144 




TRA 


6,4 




0145 


LADi 


PZE 




LENGTH X SERIES IN ADDR. 


0146 


LAD2 


PZE 
END 




LENGTH Y SERIES IN ADDR. 


0147 
0148 
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* COSISP » * COSISP * 

»*»»*•»»**•»••»«»»*♦**»* »•»***•*****••*******»•« 

REFER TO REFER TO 

COSP COSP 



•••**»**•*••*•»*•••••#•• PROGRAM LISTINGS #«»##»»»*#»»»»****#*#*»# 

* COSIS1 * « COSIS1 » 

•*»***«••**•*•*•***•»*•• ***»•*»*•••••*•»*•••••** 



9/10/64 LAST CARD IN DECK IS NO. 



* C0SIS1 (SUBROUTINE) 

* LABEL 
CC0SIS1 

SUBROUTINE COSISl ( JOB, XX, LX , COST AB f S INTAB , M, JM IN, JMAX, 
1 CTR,STR, ADD, SPACE, I ANS ) 



ABSTRACT 

TITLE - COSISl 

FAST COSINE AND/OR SINE TRANSFORMS OF ODD-LENGTH SERIES 

COSISl PRODUCES A HIGH-SPEED COSINE AND/OR SINE TRANSFORM 
(OR PORTION THEREOF) FROM AN ODD-LENGTH SERIES XU), 
I=-N,-N+1,...,N 



CT( J) 



AND/OR 



ST(J) * 



N 
SUM 
I=~N 

N 
SUM 
I=-N 



( X(I)*COS(I*J»PI/M) ) 



( X(I)*SIN(I»J*PI/M) ) 



FOR J * JMIN, JMIN+1, « 



, JMAX 



WHERE 



LANGUAGE 
EQUIPMENT 
STORAGE 
SPEED 



AUTHOR 



PI = 3,14159265 

N,M,JMIN AND JMAX ARE INPUT PARAMETERS 
C0S(J»PI/M) AND/OR SIN(J*PI/M) J=0,1,...,M 

ARE REQUIRED AS INPUT TABLES 
0 LSTHN= JMIN LSTHN JMAX L STHN- M 

SPEED IS ATTAINED BY 

1. SPLITTING THE X(I) SERIES INTO ODD AND EVEN 

PARTS AND, IF N = M, RESPL ITT ING THESE INTO 
THEIR ODD AND EVEN SUBPARTS. 

2. USING THE HIGH-SPEED LOOPING LOGIC OF SUBROUTINE 

COSISP TO PERFORM THE TRANSFORMATIONS OF THE 
SHORTENED SUBPARTS. 

AN OPTION IS PROVIDED FOR ADDING CT( I ) AND OR STI I ) TO 
THE OUTPUT AREA RATHER THAN STORING THEM THERE. 

2*N+4 TEMPORARY REGISTERS ARE REQUIRED BY COSISl UNLESS 
THE USER IS WILLING TO SACRIFICE X(I) (IN WHICH 3 EXTRA 
REGISTERS BEHIND X(I) ARE NEEDED). 

FORTRAN 1 1 SUBROUTINE 

709 OR 7090 (MAIN FRAME ONLY) 

406 REGISTERS 

FOR M-N COSISl TAKES ABOUT 

20«M«( JMAX-JMIN+l) MACHINE CYCLES (ON THE 7090$ 
TO PRODUCE EITHER THE SINE OR COSINE TRANSFORM, 

TWICE THAT TIME FOR BOTH. 

FOR M NOT= N SUBSTITUTE 2*N FOR M IN ABOVE FORMULA. 
*.A. WIGGINS, JUNE, 1963 GEOSCIENCE, INC. 



USAGE 

TRANSFER VECTOR CONTAINS ROUTINES - CHPRTS, COSISP, COSP, IXCARG,MOVREV, 

SISP, SPLIT 
AND FORTRAN SYSTEM ROUTINES - NONE 

FORTRAN USAGE 

CALL COSISK JOB, XX, LX ,COSTAB, SINT AB,M, JMIN, JMAX, CTR,STR, ADD, 
1 SPACE , I ANS ) 



INPUTS 



JOB 



INDICATES WHETHER USER DESIRES THE COSINE TRANSFORM, THE 

SINE TRANSFORM, OR BOTH. 
*1 INDICATES COSINE TRANSFORM ONLY. 



0263 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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C *2 INDICATES SINE TRANSFORM ONLY, 0075 

C *3 INDICATES COSINE AND SINE TRANSFORMS. 0076 

C 0077 

C XXU) 1*1, ...,LX CONTAINS THE SERIES X(J>, J*-N,-N+l, . . . ,N AS 0078 

C DESCRIBED IN THE ABSTRACT. 0079 

C 0080 

C LX =2*N+1 0081 

C MUST EXCEED ZERO. 0082 

C MUST BE ODD. 0083 

C 0084 

C COSTABU) 1*1,... ,MU CONTAINS COS(J»PI/M) J*0,l,...,M 0085 

C IS DUMMY ARGUMENT IF J0B=2 0086 

C 0087 

C SINTABU) I*1,..,»,M+1 CONTAINS SINU*PI/M) J*0»l,...,M 0088 

C IS DUMMY ARGUMENT IF J0B*1 0089 

C 0090 

C M MUST EXCEED 0 0091 

C IF * N C0SIS1 BECOMES MUCH MORE EFFICIENT - SEE SPEED. 0092 

C 0093 

C JMIN MUST BE NON-NEGATIVE. 0094 

C 0095 

C JMAX MUST BE GRTHN JMIN, LSTHN* M 0096 

C 0097 

C ADD *0. IMPLIES THAT OUTPUTS ARE TO BE STORED IN THE OUTPUT 0098 

C AREA WITHOUT ADDITION. 0099 

C NOT* 0. IMPLIES THAT THE OUTPUTS ARE TO ADDED INTO THE 0100 

C OUTPUT AREA. 0101 

C 0102 

C SPACE(I) I*l,...,LX+3 IS A BLOCK OF TEMPORARIES NEEDED BY C0SIS1. 0103 

C MAY BE EQUIVALENT TO XXU) (XXU) WILL BE DESTROYED). 0104 

C NOTfc THAT 3 ADDITIONAL SPACES ARE NEEDED IN ADDITION TO 0105 

C THE LENGTH OF XXU). 0106 

C 0107 

C 0108 

C OUTPUTS 0109 

C 0110 

C CTR(I) 1*1,..., JMAX-JMIN+1 CONTAINS CT(J) J*JM IN, • • • , JMAX AS 0111 

C DEFINED IN THE A8STRACT. 0112 

C IS DUMMY ARGUMENT IF J0B=2 0113 

C 0114 

C STRil) I*l,...,JMAX-JMIN+l CONTAINS ST(J) J=JM IN, . . . , JMAX AS 0115 

C DEFINED IN THE ABSTRACT. 0116 

C IS DUMMY ARGUMENT IF J0B*1 0117 

C 0118 

C IANS -0 NORMALLY 0119 

C =1 IF JOB ILLEGAL (NOT * 1,2, OR 3) 0120 

C =3 IF LX ILLEGAL ( LSTHN* 0, OR ODD) 0121 

C *6 IF M ILLEGAL (LSTHN* 0) 0122 

C *7 IF JMIN ILLEGAL (LSTHN 0) 0123 

C =8 IF JMAX ILLEGAL (LSTHN* JMIN, OR GRTHN M) 0124 

C 0125 

C 0126 

C EXAMPLES 0127 

C 0128 

C 1. COMPLETE SPECTRUM, NOT TRYING TO SAVE SPACE, 2»M+1 NOT * LX 0129 

C INPUTS - LX*7 XXU. ..7) * -36. ,-27 . ,- 18. , 2. , 22. , 33* , 44. 0130 

C M*2 COSTAB ( 1 ... 3 ) = l.,0.,-l. S INTAB ( I . . * 3 ) * 0*,l.,0. 0131 

C J08*3 JMIN*0 JMAX*M ADD*0. 0132 

C USAGE - CALL C0SIS1 ( JOB, XX ,LX , COSTAB , SI NTAB ,M, JMIN, JMAX , 0133 

C 1 CTR,STR, ADD, SPACE, IANS) 0134 

C OUTPUTS - IANS*0 0135 

C CTRU...3) * 20. ,-4. ,-4. STRU...3) * 0.,-40.,0. 0136 

C 0137 

C 2. COMPLETE SPECTRUM SAVING SPACE, 2*M+1 NOT* LX 0138 

C INPUTS - SAME AS EXAMPLE 1. 0139 

C USAGE - CALL C0SIS1 < JOB, XX, LX , COSTAB, SI NT AB §M, JMIN, JMAX , 0140 

C I CTR,STR,ADD,XX, IANS) 0141 

C OUTPUTS - SAME AS EXAMPLE 1. EXCEPT XX(1...10) ARE DESTROYED. 0142 

C 0143 

C 3. COMPLETE COSINE SPECTRUM, NOT TRYING TO SAVE SPACE, 2»M+1*LX 0144 

C INPUTS - LX*5 XXU. ..5) = -17. ,-5. ,9. , 7. , 18. 0145 

C M*2 COSTABU. ..3) * l.,0.,-l. 0146 

C J0B*1 JMIN=0 JMAX*M ADD*0. 0147 

C USAGE - CALL C0SIS1 ( JOB , XX, LX , COSTAB, DUMMY, M, JM IN, JMAX, 0148 

C I CTR, DUMMY, ADD, SPACE, IANS) 0149 
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C OUTPUTS - IANS=0 0150 

C CTRU...3) = 12. ,8. ,8. 0151 

C 0152 

C 4. COMPLETE SINE SPECTRUM, NOT TRYING TO SAVE SPACE, 2»M+1=LX, ANO 0153 

C ADDING OUTPUT INTO OUTPUT AREA. 0154 

C INPUTS - LX=5 XXU...5) = - 17. ,-5. , 9. , 7. , 18. 0155 
C M=2 SINTABt 1...3) » 0., 1., 0. STR(1„.„3I * 1., 1., 1. 0156 

C J0B=*2 JMIN^O JMAX^M A0D=*l. 0157 

C USAGE - CALL COSISl ( JOB, XX, LX, DUMMY, SINTAB,M, JMIN, JMAX, 0158 

C 1 DUMMY, STR, ADD, SPACE, IANS) 0159 

C OUTPUTS - IANS=0 0160 

C STRU...3) = 1., 13., 1. 0161 

C 0162 

C 5. ERROR EXITS WITH NO COMPUTATION 0163 

C USAGE - CALL COSISl ( 0, XX, 3, COSTAB, SI NTAB,3 , 0, 3, 0164 

C I CTR, STR, ADD, SPACE, I ANSI) 0165 

C CALL COSISl (3,XX,2,C0STAB,SINTAB,3,0,3, 0166 

C 1 CTR, STR, ADD, SPACE, IANS2) 0167 

C CALL COSISl (3,XX,3,C0STAB,SINTAB,0,0,3, 0168 

C I CTR, STR, ADD, SPACE, IANS3I 0169 

C CALL COSISl (3,XX,3,C0STAB,SINTAB,3,-1,3, 0170 

C 1 CTR, STR, ADD, SPACE, IANS4) 0171 

C CALL COSISl (3,XX,3,C0STAB,SINTAB,3,5,4, 0172 

C I CTR, STR, ADD, SPACE, IANS5) 0173 

C OUTPUTS - IANSl=l (ILLEGAL JOB) 0174 

C IANS2=3 (ILLEGAL LX) 0175 

C IANS3*6 (ILLEGAL M) 0176 

C IANS4=7 (ILLEGAL JMIN) 0177 

C IANS5=8 (ILLEGAL JMAX AND JMIN) 0178 

C 0179 

C 0180 

C PROGRAM FOLLOWS 0181 

C 0182 

DIMENSION XX(2),CM(2) 0183 

COMMON CM 0184 

J= JOB 0185 

L=LX 0186 

JMN^JMIN 0187 

JMX=JMAX 0188 

C CHECK LEGALITIES OF INPUT PARAMETERS 0189 

IAN=0 0190 

IF (J*(4-J)) 10,10,20 0191 

10 IAN^l 0192 

GO TO 999 0193 

20 IF (L ♦XM0DF(L,2)) 30,30,40 0194 

30 IAN=3 0195 

GO TO 999 0196 

40 IF (M) 50,50,60 0197 

50 IAN=6 0198 

GO TO 999 0199 

60 IF (JMN) 70,80,80 0200 

70 IAN=7 0201 

GO TO 999 0202 

80 IF (JMX-JMN) 100,100,90 0203 

90 IF (M-JMX) 100,110,110 0204 

100 IAN=8 0205 

GO TO 999 0206 

110 CONTINUE 0207 

M1=M 0208 

IF (ADD) 120,130,120 0209 

120 M1=-M1 0210 

130 CONTINUE 0211 

N=L/2 0212 

LS^N+1 0213 

CALL IXCARG (SPACE, ISS) 0214 

I$A=ISS*LS*1 0215 

C SPLIT XX ONCE ONTO SPACE 0216 

CALL SPLIT (XX,L,1.,CM( ISS) ,CM( ISA-l) ) 0217 

CALL MOVREV(N,l,CM(ISA-l), 1,CM( ISA+1),1) 0218 

CM(ISA-1)=0. 0219 

CM(ISA)=0. 0220 

ISL«ISS+L+2 0221 

CM(ISL)=0. 0222 

C CHECK IF FURTHER SPLITTING IS VALID 0223 

IF ( M-N) 300,200,300 0224 
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C YES IT IS VALID 0225 

200 CONTINUE 0226 

LSS=N/2 0227 

GO TO (210,230,210), J 0228 

C SPLIT AND REVERSE SYMMETRICAL PART 0229 

210 CONTINUE 0230 

IAS=ISS+LSS+l 0231 

CALL SPLIT (CM(ISS),LS,l.,CMCISS),CMUAS)) 0232 

CALL CHPRTS(CM(ISS),CM(IAS),LS) 0233 

GO TO (220, 10,230) » J 0234 

C ONLY COSINE TRANSFORM WANTED - CALL COSP. 0235 

220 CONTINUE 0236 

CALL COSP (CM(ISS),CM(IAS),LSS,C0STAB,M1,JMN,JMX,1.,CTRI 0237 

GO TO 999 0238 

C SPLIT ANO REVERSE ANTI SYMMETRICAL PART 0239 

230 CONTINUE 0240 

IAA*ISA+LSS+1 0241 

CALL SPLIT (CM(ISA),LS,1..CM(ISA),CMIIAA)) 0242 

CALL CHPRTS(CM(ISA),CM(IAA),LS) 0243 

GO TO (10,240,250) , J 0244 

C ONLY SINE TRANSFORM WANTED - USE SISP 0245 

240 CONTINUE 0246 

CALL SISP (CM(ISA),CM(IAA),LSS,SINTA8,M1,JMN,JMX,U,STR) 0247 

GO TO 999 0248 

C BOTH COSINE AND SINE TRANSFORMS WANTED - USE COSISP 0249 

250 CONTINUE 0250 

CALL COSISP (CM(ISS),CM(IAS),CM(ISA),CM(IAA),LSS,COSTAB,SINTAB, 0251 

1 M1,JMN, JMX,l.,CTR,STR) 0252 

GO TO 999 0253 

C FURTHER SPLITTING IS NOT VALIO 0254 

300 CONTINUE 0255 

IAS=ISS 0256 

IAA=ISA 0257 

LSS=N 0258 

GO TO (220,240,250), J 0259 

C THAT" S ALL. 0260 

999 IANS=IAN 0261 

RETURN 0262 

END 0263 
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COSP ( SUBROUTINE) 
FAP 



9/29/64 LAST CARD IN DECK IS NO. 



•COSP 



COUNT 1000 

LBL COSP 

ENTRY COSP ( SSX, AS X,L» COST AS »M, JMIN, J MAX, TYPE, COSTR) 

ENTRY SISP (SAX, AAX,L,SINTAB,M, JMIN, JMAX, TYPE, SINTR) 

ENTRY COS ISP ( SSX , ASX ,SAX, AAX , L, COSTAB, S I NTAB,M , JMIN, JMAX, TYPE , 

* COSTR, SINTR) 
* 

« ABSTRACT 

• 

* TITLE - COSP WITH SECONDARY ENTRY POINTS SISP AND COSISP 

* FAST COSINE AND/OR SINE TRANSFORMS FROM 2 OR A EVEN-ODD PARTS 
» 

» COSP COMPUTES COSINE SUMS, CTU) J=JMIN,«. • , JMAX , ON 

» TWO INPUT SERIES, SSU) AND ASCI) 1 = 0,1,... ,L , ACCORDING 

* TO L 

* SUM ( SS( I )*COS( I*J*(PI/M)) ) J EVEN 

* 1=0 

* CTU) = 

* L 

» SUM ( AS( I)»CQS( I*J*(PI/M)) ) J ODD 

* 1*0 
* 

» FOR J =JMIN,JMIN+1,«..,JMAX 

* WHERE 

* PI = 3.14159265 

» M * INPUT PARAMETER 

» COS( I*(PI/M) ) I=0,i,...,M IS AN INPUT TABLE 

* SS(I),AS(I), MAY BE EITHER FIXED OR FLOATING POINT 

* (THE COSINE TABLE MUST CORRESPOND IN TYPE) 
» 0 LSTHN= JMIN LSTHN JMAX LSTHN= M 

» 

» SISP COMPUTES SINE SUMS, ST(J) 

* L 

* SUM ( AA( I)»SIN( I*J*(PI/M) ) ) J EVEN 
» 1=0 



ST(J) = 



SUM ( SA(I)*SIN(I»J»(PI/M)) ) 

1=0 



J ODD 



• FOR J = JMIN, JMIN+1,..., JMAX 

• WHERE 

• SIN( I*(PI/M) ) 1=0, I, ...,M IS AN INPUT TABLE 

» AA, S A, AND THE SINE TABLE ARE FIXED OR FLOATING 

• 

» COSISP COMPUTES BOTH CT ( J ) AND ST(J) AS DEFINED ABOVE 

* 

• AN OPTION IS PROVIDED FOR ADDING THE TRANSFORMS INTO THE 

• OUTPUT AREAS. 
* 

• NOTE THAT THE FUNDAMENTAL FREQUENCY AS DEFINED BY THE 

• INPUT TABLES HAS PERIOD = EVEN NO. OF POINTS = 2M 
» 

• LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 

• EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 
» STORAGE - 504 REGISTERS 

709-FIXED PT 709-FLOATING PT 
COSP 34»K*(L+1) 37»K»(L+1) 
SISP 39*K»(L+l) 43*K*(L+1) 
COSISP 67*K*(L+1) 72*K*(L+1) 
WHERE K = JMAX-JMIN+l 

(REDUCE ESTIMATES ABOUT 10 PERCENT FOR 7090) 
• S.M. SIMPSON, OCT 26, 61 



* SPEED 



* AUTHOR 



MACHINE CYCLES 
MACHINE CYCLES 
MACHINE CYCLES 



USAGE 



* TRANSFER VECTOR CONTAINS ROUTINES - 

* AND FORTRAN SYSTEM ROUTINES - 



NONE 
NONE 



» FORTRAN USAGE OF COSP 

* CALL COSP (SSX, ASX, L, COSTAB, M, JMIN, JMAX, TYPE, COSTR) 



0877 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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» INPUTS TO COSP 0075 

* 0076 

* SSXU) 1=1. ..L+l CONTAINS SSU) J=0,1,...,L FIXED OR FLOATING 0077 
» 0078 
» ASX(I) 1=1. ..L + l CONTAINS AS ( J ) J=0,1,...,L FIXED OR FLOATING 0079 

* EQUIVALENCE (SSX, ASX) IS PERMITTED 0080 

* 0081 
» L MUST EXCEED 0 0082 
» 0083 

* COSTABtl) 1 = 1. ..M+l CONTAINS COS(J*PI/M) J= 0,1, ...,M 0084 

* C0STA8 IS FIXED OR FLOATING 0085 

* FOR FIXED POINT IT IS ASSUMED THAT THE BINARY POINT 0086 
» IS BETWEEN THE SIGN BIT AND BIT 1 SO THAT VALUES 0087 

* 1.0 AND -1.0 SHOULD BE ENTERED AS OCTAL 377777777777 0088 

* AND 777777777777 RESPECTIVELY. THE BINARY POINT OF 0089 
» SSX AND ASX IS IMMATERIAL, BUT OVERFLOW MAY ARISE. 0090 

* 0091 

* M IS LENGTH OF COSTAB. 0092 

* IF NEGATIVE, COSP ADDS TRANSFORM CT(I) TO THE OUTPUT 0093 
» BEFORE STORING IN THE OUTPUT AREA. 0094 

* MUST NOT =0 0095 
» 0096 
» JMIN DEFINfrS LOWEST MULTIPLE OF FUNDAMENTAL DESIRED 0097 

* MUST 8E GRTHN= 0 AND LSTHN JMAX 0098 

* 0099 

* JMAX DEFINES HIGHEST MULTIPLE OF FUNDAMENTAL DESIRED 0100 

* MUST BE GRTHN JMIN AND LSTHN= M 0101 

* 0102 

* TYPE = 0.0 SIGNIFIES SS,AS, AND COSTAB ARE FIXED PT. 0103 

* NOT= 0.0 MEANS SS,AS, AND COSTAB ARE FLTG. PT* 0104 
» 0105 

* OUTPUTS FROM COSP 0106 

* 0107 

* COSTR(I) 1=1... JMAX- JMIN+1 CONTAINS CT(J> J=JMIN. . . JMAX AS 0108 

* DEFINED IN ABSTRACT. 0109 

* 0110 

* { PROGRAM EXITS WITHOUT COMPUTATION IF L,M,JMIN, 0111 

* OR JMAX ILLEGAL) 0112 

* 0113 

* FORTRAN USAGE OF SISP 0114 
» CALL SISP (SAX, AAX,L,SINTAB,M, JMIN, JMAX, TYPE, SINTRJ 0115 

* 0116 
» INPUTS TO SISP 0117 
» 0118 
» SAX(I) 1 = 1. ..LU CONTAINS SA(J) J=0,1,...,L 0119 

* 0120 

* AAX(I) 1=1.. .L+l CONTAINS AA(J) J=0,1,...,L 0121 

* EQUIVALENCE (SAX,AAX) IS PERMITTED. 0122 
» 0123 

* L SAME MEANING AS FOR COSP 0124 
» 0125 

* SINTAB(I) 1=1.. .M+l CONTAINS SIN(J*Pl/M) J=0,1,...,M 0126 

* 0127 

* M SAME MEANING AS FOR COSP 0128 
« 0129 

* JMIN SAME MEANING AS FOR COSP 0130 

* 0131 

* JMAX SAME MEANING AS FOR COSP 0132 

* 0133 

* TYPE SAME MEANING AS FOR COSP 0134 

* 0135 

* OUTPUTS FROM SISP 0136 
» 0137 

* SINTR(I) 1=1... JMAX-JMIN+1 CONTAINS ST(J) J=JMIN. . . JMAX AS 0138 

* DEFINED IN ABSTRACT 0139 

* 0140 

* FORTRAN USAGE OF COSISP 0141 

* CALL COSISP(SSX, ASX, SAX, AAX,L, COSTAB, SINTAB,M, JMIN, JMAX, 0142 

* 1 TYPE,COSTR,SINTR) 0143 

* 0144 

* WHERE ARGUMENTS ARE THE SAME AS FOR COSP AND SISP 0145 

* EQUIVALENCE ( SSX , ASX , S AX, AAX ) IS PERMITTED. 0146 

* 0147 

* EXAMPLES 0148 

* 0149 
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* 1. USE OF COSP, SISP, COSISP WHEN ALL INPUTS EQUATED, FIXED AND 0150 

* FLOATING, ALL FREQUENCIES 0151 

* INPUTS - XU...4) * l.,2.,3.,4. IXU...4) * 100,200,300,400 L = 3 0152 

* C0STAB(1...3)=1. 0,0. 0,-1.0 SINTA8( 1.. .3)=0.0, 1.0,0*0 M*2 0153 

* ICOSTBl 1...3>=0CT377777777777, 000000000000,777777777777 0154 
» ISINT8( 1...3>=OCT0OO000OO00OO, 377777777777, 000000000000 0155 

* JMIN = 0 JMAX * 2 0156 

* USAGE - CALL COSP ( X , X,L ,C0STAB, M, JMIN, JMAX, 1., CI ) 0157 
» CALL COSP UX, IX, L,IC0STB,M, JMIN, JMAX, 0..IC1) 0158 

* CALL SISP IX,X,L,SINTAB,M, JMIN, JMAX, 1. , SI > 0159 
» CALL SISP (IX,IX,L,ISINTB,M,JMIN,JMAX,0., IS1) 0160 

* CALL COSISP (X,X,X,X,L,C0STA8,SINTAB,M, JMIN, JMAX, 0161 
» l.,C2,S2) 0162 

* CALL COSISP UX,IX,1X,IX,L,IC0STB,ISINTB,M,JMIN, 0163 
» JMAX,0., IC2, IS2) 0164 

* OUTPUTS - CK1...3) = C2<1...3> = 10. ,-2. ,-2. 0165 

* SKI. ..3) « $2(1. ..3) = 0.,-2.,0. 0166 

* ICK1...3) = IC2(1...3) * 1000,-200,-200 0167 

* ISK1...3) = IS2U...3) = 0,-200,0 0168 

* 0169 

* 2. PARTIAL FREQUENCY COVERAGE 0170 
» INPUTS - SAME AS EXAMPLE 1. EXCEPT JMIN = 1 0171 

* USAGE - SAME AS EXAMPLE 1. 0172 
» OUTPUTS - CHI. ..2) = C2(1...2> = -2. ,-2. 0173 
» SKI. ..2) = S2U...2) = -2.,0. 0174 
» ICK1...2) = IC2U...2) * -200,-200 0175 

* ISK1...2) = IS2(1...2) = -200,0 0176 

* 0177 
» 3. USE OF COSISP TO FIND COEFFICIENTS OF TRIGONOMETRICAL SERIES FOR 0178 
» AN EVEN-LENGTH VECTOR 0179 

* (SEE CARSLAW, 1930, FOURIER SERIES AND INTEGRALS, P324,325) 0180 

* GIVEN XX(I) 1=1.. .2»M CONTAINING X(J) J=0, 1, * . . , 2»M-1 0181 
» FIND A(0),A(1),...A(M) AND B( 1 ), B( 2 >,..., B ( M-l ) SUCH THAT 0182 

* 0183 
» Xt J)=At0)+A( 1)C0S( J*D)+...+A(M-l)COSU J-l )»D)+A(M)COS( PI) 0184 

* +B(1)SIN( J*D)+...+B(M-l)SIN(( J-1)»D) 0185 

* WHERE D=PI/M J=0,1,...,2*M-1 0186 
» SOLUTION 0187 
» INPUTS - C0STABU...M+1) = C0S(J*PI/M) J = 0,1, ...,M 0188 

* SINTAB(l...M+i> = SIN(J*PI/M) J = 0,1,...,M 0189 

* L = 2*M-1 0190 

* USAGE - CALL COS I SP ( X, X, X, X, L,COSTAB, SINTAB,M, 0,M, U , AA, BB) 0191 

* AAU) = AA(1)/FL0ATF(2»M) 0192 

* AACM+l) = AA(M+l)/FL0ATF(2*M) 0193 

* DO 10 1-2, M 0194 
» AA( I )=AA( I )/FLOATF(M) 0195 
» 10 B6U)=BB(I)/FL0ATF(M) 0196 

* OUTPUTS - AA(1...M+1) WILL CONTAIN A( 0 > , A< 1 ) , .. . A( M) AS REQUIRED 0197 

* BB(2...M) WILL CONTAIN B( 1 ) , . . .8 ( M-l ) AS REQUIRED 0198 

* (BB(1)»BB(M+1)*0.) 0199 

* 0200 

* 4. USE OF COSISP TO INVERT COEFFICIENTS OF TRIG SERIES FOR AN EVEN- 0201 

* LENGTH VECTOR 0202 
» GIVEN A(0),...A(M) B( 1 ) . . .B( M-l ) AS DEFINED ABOVE 0203 

* FIND X(J) = TRIG SERIES ABOVE J = 0, 1 , • . • « 2*M-l 0204 
» SOLUTION 0205 

* INPUTS - AAU) AND BB( I ) ARE SAME AS OUTPUTS OF EXAMPLE 3. 0206 
» USAGE - CALL COS I SP ( AA, AA, BB, BB,M, COSTAB, SINTAB, 0207 
» 1 M,0,M,1.,XS,XA) 0208 
» I2M=2*M 0209 

* DO 20 1=2, M 0210 

* J=I2M+2-I 0211 

* X$(J)=XS(I) 0212 

* 20 XA(J)=-XA(I) 0213 

* DO 30 1=1, I2M 0214 
» 30 XBAC(I)=XA(I)+XS(I) 0215 

* OUTPUTS - XBAC(1...2»M) WILL CONTAIN X ( 0, 1 , . . . , 2*M-1 ) AS REQUIRED 0216 

* 0217 

* 5. ILLUSTRATION OF FINDING TRIG SERIES 0218 
» INPUTS - SAME AS EXAMPLE 1. 0219 

* USAGE - SAME AS EXAMPLE 3. 0220 

* OUTPUTS - AA(1..*3) = 2. 5,-1. ,-.5 0221 

* BB(1...3) = 0.,-l.,0. 0222 

* 022 3 
» 6. ILLUSTRATION OF INVERTING TRIG SERIES 0224 
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» INPUTS - SAME AS EXAMPLE 5. WITH AA,BB, SAME AS OUTPUTS FROM EX 5* 0225 

* USAGE - SAME AS EXAMPLE 4. 0226 

* OUTPUTS - XBAC11...4) = l.,2.,3.,4. 0227 

* 0228 

* 7. USE OF SYMMETRIES TO REOUCE TIME IN COMPUTING TRANSFORMS ABOUT 0229 

* MIDPOINT OF AN ODD-LENGTH SERIES 0230 

* GENERAL FORM 0231 
» I=M 0232 

* C(J) = SUM ( XU)*COSH*J*PI/M> ) 0233 

* I=-M 0234 

* AND 0235 

* I=M 0236 

* S(J) ^ SUM ( X( I )*SIN< I*J*PI/M) ) 0237 

* I=-M 0238 
» J = JMIN...JMAX 0239 

* SUPPOSE X(-6...6)*l.,3.,i.,2., 1. , 1. , 5. , 4. , 3. , 3. ,5. ,4. , 1. 0240 

* FIRST SPLIT X ABOUT ITS MIDPOINT INTO ITS SYMMETRIC AND 0241 
» ANT I SYMMETRIC PARTS 0242 

* SX11...7) = 5., 5. ,4. ,5. ,6. ,7., 2. 0243 

* AXU...7) * 0.,3.,2.,l.,4.,l.,0. 0244 

* THEN SPLIT EACH OF THESE ABOUT THEIR MIDPOINTS 0245 

* SSXU...4) « 5., 10., 12., 7. ASXU...4) * 0. t 2.i2. f -3. 0246 
» SAXU...4) = l.,6.,4.,0. AAXC1...4) * 0.,2.,-2*,0. 0247 

* INPUTS - THEN REVERSE ALL THE VECTORS AND CHANGE SIGNS OF ASX 0248 

* AAX TO GIVE 0249 

* SSXU...4) » 7., 12., 10. ,5. ASXU...4) = 3. ,-2. .-2. ,0. 0250 

* SAXU...4) » 0.,4.,6.,1. AAXC1...4) « 0*,2.,-2.t0. 0251 

* L=3 M^=6 C0STAB<1...7)=C0S( J*PI/6) 0252 

* SINTAB(1...7)=SIN( J*PI/6) J = 0...6 0253 

* USAGE - CALL COSISP ( SSX,ASX,SAX, AAX, 3,C0STAB, SINTAB,M,0, M f 0254 

* l.,COSTR, SINTR) 0255 
» OUTPUTS - C0STR(i...7) = C(0...6) * 34. , .26795, 3. • 5. , 1. , 3. 73205, 0. 0256 

* SINTRU...7) = SI0...6) = 0. , 8. 19615, 0. , 3. , 3.46410, 0257 
» -2.19615,0. 0258 
» 0259 

* 8. ADDITION OF OUTPUTS TO VALUES ALREADY IN THE OUTPUT AREA 0260 
» 0261 
« INPUTS - SAME AS EXAMPLE 1. EXCEPT M=-2 0262 

* CK1...3) = C2C1...3) = l.,2.,3. 0263 

* SKI. ..3) * S2U...3) = l.,-l.,-2. 0264 

* ICK1...3)* IC2<1...3>= 100,200,300 0265 

* IS1(1...3)= IS2(1...3)= 100,-100,-200 0266 

* USAGE - SAME AS EXAMPLE I. 0267 

* OUTPUTS - CK1...3) = C2C1...3) * li.,0.,1. 0268 
» SKI. ..3) = S2U...3) = l.,-3.,-2. 0269 

* ICK1...3)* IC2(1...3)= 1100,0,100 0270 

* ISK1...3> = IS2<1...3)= 100,-300,-200 0271 

* 0272 
« PROGRAM FOLLOWS BELOW 0273 

* NOTATION DIFFERENCES IN PROGRAM NOTES ARE 0274 

* RSS^SSX RAS=ASX RAA=AAX RSA^SAX 0275 

* P=L 0276 

* 0277 

* 0278 
HTR 0 0279 
BCI 1,C0SP 0280 

COSP SXD *-2,4 SET UP EXIT 0281 

SXA LV+1,1 0282 

SXA LV+2,2 0283 

CLA K10 0284 

STA EXIT 0285 

♦SET ARGUMENT TABLE 0286 

CLA 1,4 0287 

STA Ti 0288 

CLA 2,4 0289 

STA T2 0290 

CLA* 3,4 0291 

STD T5 0292 

CLA 4,4 0293 

STA T6 0294 

CLA* 5,4 0295 

STO T8 0296 

CLA* 6,4 0297 

STO T9 0298 

CLA* 7,4 0299 
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STD 


TIO 




0300 


CIA* 


8*4 




0301 


STO 


Til 




0302 


CLA 


9,4 




0303 


STA 


T12 




0304 


♦SET COSP SWITCHES 




0305 


CLA 


KA18 


KA6 


0306 


STA 


Z30 




0307 


CLA 


KA6 


Z90 


0308 


STA 


Z33 




0309 


CLA 


KA15 


Z107 


0310 


STA 


Z106 




0311 


CLA 


KA19 


Z130 


0312 


STA 


Z109B 




0313 


CLA 


KT1 


TRA Z104 


0314 


STO 


Z114 




0315 


STO 


Z112 




0316 


CLA 


KT2 


TRA Z102 


0317 


STO 


Z121A 




0318 


STO 


Z122A 




0319 


TRA 


Z14 




0320 


*SET EXIT 






0321 


SISP SXO 


COSP-2,4 




0322 


SXA 


LV+ 1,1 




0323 


SXA 


LV+2,2 




0324 


CLA 


KIO 




0325 


STA 


EXIT 




0326 


•SET ARGUMENT 


TABLE 




0327 


CLA 


1,4 




0328 


STA 


T3 




0329 


CLA 


2,4 




0330 


STA 


T4 




0331 


CLA* 


3,4 




0332 


STD 


T5 




0333 


CLA 


4,4 




0334 


STA 


T7 




0335 


CLA* 


5,4 




0336 


STO 


T8 




0337 


CLA* 


6,4 




0338 


STD 


T9 




0339 


CLA* 


7,4 




0340 


STD 


TIO 




0341 


CLA* 


8,4 




0342 


STO 


Til 




0343 


CLA 


9,4 




0344 


STA 


T13 




0345 


♦SET SISP SWITCHES 




0346 


CLA 


KA14 


KA9 


0347 


STA 


Z30 




0348 


CLA 


KA9 


Z50 


0349 


STA 


Z33 




0350 


CLA 


KA7 


ZlOO 


0351 


STA 


Z56 




0352 


STA 


Z66 




0353 


STA 


Z76 




0354 


STA 


Z86 




0355 


CLA 


KA16 


Z115 


0356 


STA 


Z106 




0357 


CLA 


KZ1 


ZET SWE 


0358 


STO 


Z114 




0359 


STO 


Z112 




0360 


CLA 


KZ2 


ZET SWO 


0361 


STO 


Z121A 




0362 


STO 


Z122A 




0363 


TRA 


Z14 




0364 


♦SET EXIT 






0365 


COSISP SXD 


COSP-2,4 


SET UP EXIT 


0366 


SXA 


LV+1, 1 




0367 


SXA 


LV+2,2 




0368 


CLA 


K14 




0369 


STA 


EXIT 




0370 


♦SET UP ARGUMENT TABLE 




0371 


CLA 


1*4 




0372 


STA 


Tl 




0373 


CLA 


2,4 




0374 
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0375 
0376 
0377 
0378 
0379 
0380 
0381 
0382 
0383 
0384 
0385 
0386 
0387 
0388 
0389 
0390 
0391 
0392 
0393 
0394 
0395 
0396 
0397 
0398 

KA9 0399 

0400 

Z50 0401 

0402 

Z90 0403 

0404 
0405 
0406 
0407 

Z107 0408 

0409 

Z£T SWE 0410 

0411 
0412 

ZET SWO 0413 

0414 
0415 

Z115 0416 

0417 
0418 

•MAKE COMMON SETTINGS FOR COSP, SISP, COSISP AS IF IT WERE COSISP 0419 
•FIRST FOR FIXED POINT OR FLOATING POINT 0420 
Z14 



Z15 
Z16 



STA 


T2 


CLA 


3,4 


STA 


T3 


CLA 


A. A 


STA 


T4 


CLA* 


5.4 


STD 


T5 


CLA 


6*4 


STA 


T6 


CLA 


7.4 


STA 


T7 


CLA» 


8 » 4 


STO 


T8 


CLA* 


9,4 


STO 


T9 


CLA* 


10,4 


STD 


T10 


CLA* 


11,4 


STO 


Til 


CLA 


12,4 


STA 


T12 


CLA 


13,4 


STA 


T13 


ISI SP 


SWI TCHES 


CLA 


KA 14 


STA 


Z30 


CLA 


KA9 


STA 


Z33 


CLA 


KA6 


STA 


Z56 


STA 


266 


STA 


Z76 


STA 


Z86 


CLA 


KA15 


STA 


Z106 


CLA 


KZ1 


STO 


Z114 


STO 


Z112 


CLA 


KZ2 


STO 


Z121A 


STO 


Z122A 


CLA 


KA16 


STA 


Z109B 


TRA 


Z14 



ZET 


Til 


0421 


TRA 


Z15 FLOATING 


0422 


CLA 


MPY FIXED 


0423 


LDQ 


ADD 


0424 


TRA 


Z16 


0425 


CLA 


FMP FLOATING 


0426 


LDQ 


FAD 


0427 


STO 


Z51 


0428 


STO 


Z61 


0429 


STO 


Z71 


0430 


STO 


Z81 


0431 


STO 


Z91 


0432 


STQ 


Z52 


0433 


STQ 


Z62 


0434 


STQ 


Z72 


0435 


STQ 


Z82 


0436 


STQ 


Z92 


0437 


STO 


Z54 


0438 


STO 


Z64 


0439 


STO 


Z74 


0440 


STO 


Z84 


0441 


STO 


Z94 


0442 


STQ 


Z55 


0443 


STQ 


Z65 


0444 


STQ 


Z75 


0445 


STQ 


Z85 


0446 


STQ 


Z95 


0447 


SLQ 


Z108 


0448 


SLQ 


Z109A 


0449 



COSP 
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Z17 



Z20 



SLQ 


Z116 




0450 


SLQ 


Z118 




0451 


CLA 


KA2 


SMSE 


0452 


STA 


Z52 




0453 


STA 


Z62 




0454 


STA 


Z72 




0455 


STA 


Z82 




0456 


CLA 


KA3 


SMSO 


0457 


STA 


Z55 




0458 


STA 


Z65 




0459 


STA 


Z75 




0460 


STA 


Z85 




0461 


CLA 


KA4 


SMCE 


0462 


STA 


Z92 




0463 


CLA 


KA5 


SMCO 


0464 


STA 


Z95 




0465 


ADDRESSES 




0466 


CLA 


T7 


SINTAB (OR HASH) 


0467 


STA 


Z50 




0468 


STA 


Z53 




0469 


STA 


Z60 




0470 


STA 


Z63 




0471 


STA 


Z70 




0472 


STA 


Z73 




0473 


STA 


Z80 




0474 


STA 


Z83 




0475 


CLA 


T4 


RAA (OR HASH) 


0476 


STA 


Z51 




0477 


STA 


Z61 




0478 


STA 


Z7i 




0479 


STA 


Z81 




0480 


CLA 


T3 


RSA (OR HASH) 


0481 


STA 


Z54 




0482 


STA 


Z64 




0483 


STA 


Z74 




0484 


STA 


Z84 




0485 


CLA 


T6 


COSTAB (OR HASH) 


0486 


STA 


Z90 




0487 


STA 


Z93 




0488 


CLA 


Tl 


RSS (OR HASH) 


0489 


STA 


Z91 




0490 


CLA 


T2 


RAS (OR HASH) 


0491 


STA 


Z94 




0492 


CLA 


T8 


M 


0493 


TZE 


LV 




0494 


TMI 


Z17 




0495 


CLA 


Z131A 




0496 


STD 


Z108 




0497 


STD 


Z109A 




0498 


STD 


Z116 




0499 


STD 


Z118 




0500 


CLA 


T8 




0501 


STD 


Z101 




0502 


STD 


Z103 




0503 


ADD 


T8 


2M 


0504 


STD 


2M 




0505 


CLA 


T5 


P 


0506 


TMI 


LV 




0507 


T2E 


LV 




0508 


STD 


Z105 




0509 


CLA 


TI2 


COSTR (OR HASH) 


0510 


STA 


ZI08 




0511 


STA 


Z109A 




0512 


CLA 


T13 


SINTR (OR HASH) 


0513 


STA 


Z116 




0514 


STA 


Z118 




0515 


IMIN EVEN 


SET JE= 


JMIN+1, JO«JMIN+l,ESTOR=0,OSTOR=l 


0516 


IMIN ODD 


SET JO* 


JMIN, JE = JMIN+1) ,OSTOR=0,ESTOR=sl 


0517 


CLA 


T9 


JMIN 


0518 


TMI 


LV 




0519 


CAS 


TIO 




0520 


TRA 


LV 




0521 


TRA 


LV 




0522 


ARS 


18 




0523 


LBT 






0524 



• COSP 
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Z2I 



TRA 


Lc. 1 


T ^ 


EVEN 


0525 


Al c 
ALO 


1 A 


I <i 
l j 


ODD 


0526 


O 1 u 


in 






052 7 


AUU 








0528 


CTn 
iiu 








0529 


5 1 L 


OSTOR 






0530 


f 1 A 


Kl 






053 1 


STA 


ESTOR 






0532 


TRA 


Z23 






0533 


ALS 


18 


IS 


EVEN 


0534 


STO 


JE 






0535 


ADD 


KD1 






0536 


STD 


JO 






0537 


STZ 


ESTOR 






0538 


CLA 


Kl 






0539 


STA 


OSTOR 






0540 


DUMMY 


SWITCHES 






0541 


STZ 


OUME 






0542 


STZ 


DUMO 






0543 



Z23 

♦NOW BEGIN LOOPING 

♦INITIALIZE Z105 SWITCH, CLEAR SUM REGISTERS, SET TRAVEL SWITCHES 
♦ FORWARD 

♦♦ (♦♦=KA6 COSP, ♦**KA9 OTHERWISE ) 



Z30 



CLA 
STA 
STZ 
STZ 
STZ 
STZ 
STZ 
STZ 
CLA 
STD 
CLA 
STD 



Z105 

SMSE 

SMSO 

SMCE 

SMCO 

SWE 

SWO 

JE 

Z100 
JO 

Z102 



♦SET MINUS JE,JO 



LDC 
SXD 
LDC 
SXD 



JE,1 
MJE,l 
J0,1 
MJ0,1 



♦XR4 WILL CONTROL MOTION FOR EVEN HARMONIC INDEX 
♦XR2 WILL CONTROL MOTION FOR ODD HARMONIC INDEX 
♦XR1 WILL CONTROL MOTION FOR DATA INDEX 
♦DATA INDEX*SINE INDEX^COS INE INDEX=0 
AXT 0,7 

Z33 TRA ♦♦ (♦♦=Z90 FOR COSP, *Z50 OTHERWISE) 

♦LOOP FOR FORWARD MOTION ON SINE WAVE FOR BOTH HARMONICS 
♦ THIS PART IS FOR EVEN HARMONICS (XR4) SUMMED IN SMSE 



Z50 LDQ 
Z51 NOP 
Z52 NOP 
STO 



( ♦♦^SINTAB) 

{ MPY OR FMP $$,1 WITH ♦* * RAA) 
(ADD OR FAD SMSE) 



SMSE 



THIS PART IS FOR ODD HARMONICS <XR2), SUMMED IN SMSO 



WITH ♦♦=RSA) 



Z53 LDQ •♦,2 (♦♦^SINTAB) 

Z54 NOP (MPY OR FMP ♦♦,! 

Z55 NOP (ADD OR FAD SMSO 

STO SMSO 

♦NOW GO TO COSINE SUMS IF COSISP, OR AVOID IF SISP 

Z56 TRA ♦♦ (♦♦*Z90 FOR COSISP, ♦♦=Z100 FOR SISP) 

♦LOOP FOR FORWARD MOTION ON SINE WAVE OF EVEN HARMONIC AND 

♦ REVERSE MOTION ON SINE WAVE OF ODD HARMONIC 

♦ FOR EVEN 

♦♦,4 (♦♦=SINTAB) 

(MPY OR FMP ♦♦,! 
(ADD OR FAD SMSE) 



Z60 LDQ 
Z61 NOP 
Z62 NOP 

STO 
* FOR ODD 
Z63 CLS 

XCA 

Z64 NOP 
Z65 NOP 
STO 

Z66 TRA 



WITH ♦♦=RAA ) 



SMSE 



♦ ♦,2 



SMSO 
#♦ 



( ♦♦-SINTAB) 



{ MPY OR FMP ♦♦,! 
(ADD OR FAD SMSO) 



WITH ♦♦*RSA) 



(##=Z90 IF COSISP, ♦♦=Z100 IF SISP) 



♦LOOP FOR REVERSE MOTION ON SINE WAVE OF EVEN HARMONIC AND 

♦ FORWARD MOTION ON SINE WAVE OF ODD HARMONIC 

♦ FOR EVEN 



0544 
0545 
0546 
0547 
0548 
0549 
0550 
0551 
0552 
0553 
0554 
0555 
0556 
0557 
0558 
0559 
0560 
0561 
0562 
0563 
0564 
0565 
0566 
0567 
0568 
0569 
0570 
0571 
0572 
0573 
0574 
0575 
0576 
0577 
0578 
0579 
0580 
0581 
0582 
0583 
0584 
0585 
0586 
0587 
0588 
0589 
0590 
0591 
0592 
0593 
0594 
0595 
0596 
0597 
0598 
0599 
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170 CLS («*»SINTAB) 0600 

XCA 0601 

111 NOP (MPY OR FMP **,1 WITH *«=RAA5 0602 

172 NOP (ADO OR FAD SMSE) 0603 

STO SMSE 0604 

» FOR ODD 0605 

273 LDQ ♦* f 2 (**=SINTAB) 0606 

Z74 NOP (MPY OR FMP WITH ♦♦^RSA) 0607 

Z75 NOP (ADD OR FAD SMSO) 0608 

STO SMSO 0609 

Z76 TRA ♦♦ (*»*Z90 COSISP, ♦»=Z100 IF SISP) 0610 

•LOOP FOR REVERSE MOTION ON SINE WAVE FOR BOTH HARMONICS 0611 

* THIS PART IS FOR EVEN HARMONICS 0612 
Z80 CLS »»,4 (•♦^SINTAB) 0613 

XCA 0614 

Z81 NOP (MPY OR FMP **,! WITH **=RAA) 0615 

Z82 NOP (ADD OR FAD SMSE) 0616 

STO SMSE 0617 

* THIS PART IS FOR ODO HARMONICS 0618 
Z83 CLS **,2 (•♦^SINTAB) 0619 

XCA 0620 

Z84 NOP (MPY OR FMP • *, I WITH •♦«RSA) 0621 

Z85 NOP (ADD OR FAD SMSO) 0622 

STO SMSO 0623 

♦NOW GO TO COSINE SUMS IF COSISP, OR AVOID IF SISP 0624 

Z86 TRA »* (**=Z90 FOR COSISPt •♦»Z100 FOR SISP) 0625 

•LOOP FOR FORWARD OR BACKWARD MOTION ON COSINE WAVE 0626 

♦ THIS PART FOR EVEN HARMONICS SUMMED IN SMCE 0627 
Z90 LDQ »*,4 (*»=COSTAB) 0628 
Z91 NOP (MPY OR FMP *♦, I WITH »»=RSS> 0629 
Z92 NOP (ADD OR FAD SMCE) 0630 

STO SMCE 0631 

♦ THIS PART IS FOR ODD HARMONICS SUMMED IN SMCO 0632 
Z93 LDQ »»,2 (»»*COSTAB) 0633 
Z94 NOP (MPY OR FMP «», 1 WITH »»=RAS) 0634 
Z95 NOP (ADD OR FAD SMCO) 0635 

STO SMCO 0636 

•INCREMENT INDEX FOR EVEN HARMONICS (BY + JE FOR FORWARD 0637 

• TRAVEL, BY -JE FOR REVERSE TRAVEL) 0638 
Z100 TXI ♦♦1,4, ♦* (*»*JE FORWARD) (»«*-JE REVERSE) 0639 

♦CHECK IF INDEX HAS RUN OFF END (GREATER THAN M FOR 0640 

♦ FORWARD TRAVEL, LESS THAN ZERO FOR REVERSE) 0641 

♦ (HOWEVER FOR REVERSE TRAVEL XR4 GOING NEGATIVE MEANS 0642 

• XR4 GETS GREATER THAN M, SO SAME TEST APPLIES) 0643 
Z101 TXH Z120,4,^ »»sM 0644 

•INCREMENT INDEX FOR ODD HARMONICS (BY+JO OR -(JO)) 0645 

• AND MAKE SAME KIND OF END TEST 0646 
Z102 TXI *+l,2,*« (***J0 FORWARD) (••*-J0 REVERSE) 0647 
Z103 TXH ZU0,2,»^ (»**M) 0648 

•INCREMENT DATA INDEX BY 1 AND CHECK FOR END OF DATA 0649 

• LOOPING BACK TO PLACE DETERMINED BY WHETHER COSP OR 0650 

♦ SISP OR COSISP AND FORWARD OR BACKWARD AND EVEN OR ODD 0651 
Z104 TXI ♦♦1,1,1 0652 
Z105 TXL »*,1,»# ( TXL ♦♦A,1,«B ♦♦B«P) 0653 

♦ •*A*Z90 FOR COSP 0654 

• FOR SISP OR COSISP (INITIAL = Z50) 0655 

♦ ♦»A=Z50 EVEN AND ODD HARMONICS FORWARD 0656 

• •*A=Z60 EVEN FORWARD, ODD REVERSE 0657 

♦ ♦»A=Z70 EVEN REVERSE, ODD FORWARD 0658 

♦ **A=Z80 EVEN AND ODD REVERSE 0659 
Z106 TRA •• (♦♦=Z107 FOR COSP OR COSISP, 0660 

• ♦«=Z115 FOR SISP) 0661 
•READJUSTMENTS WHEN ODD HARMONIC INDEX RUNS OFF END 0662 
•FORWARD OR BACKWARD 0663 

ZllO ZET SWO 0664 

TRA Z113 BACKWARD 0665 

CLA Kl 0666 

STO SWO 0667 

♦IF FORWARD SET TO GO BACKWARD ON ODD 0668 

Zlll SXD TEMP, 2 0669 

CLA 2M 0670 

SUB TEMP 0671 

PDX 0,2 0672 

CLA MJO 0673 

STD Z102 0674 
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♦IF COSP GO BACK* IF NOT REMAKE FORK AT Z105 0675 

♦ COSP SISP OR COSISP 0676 
2112 NOP ( IRA Z104 OR 2ET SWE) 0677 

TRA Z112A 0678 

CLA KA10 (KA10 = PZE Z60) 0679 

STA Z105 0680 

TRA Z104 0681 

Z112A CLA KA12 (KA12=PZE Z80) 0682 

STA Z105 0683 

TRA Z104 0684 

•IF BACKWARDS SET TO GO FORWARDS ON ODD 0685 

Z113 STZ SWO 0686 

PXA 0,2 0687 

PAC 0*2 0688 

CLA JO 0689 

STD Z102 0690 

♦IF COSP GO BACK, IF NOT REMAKE FORK AT Z105 0691 

♦ COSP SISP OR COSISP 0692 
Z114 NOP (TRA Z104 OR ZET SWE) 0693 

TRA ZU4A 0694 

CLA KA9 (KA9*PZE Z50) 0695 

STA Z105 0696 

TRA Z104 0697 

Z114A CLA KA11 (KA11=PZE Z70) 0698 

STA Z105 0699 

TRA Z104 0700 

♦READJUSTMENT WHEN EVEN HARMONIC INDEX RUNS OFF END 0701 

♦WHICH WAY WERE WE GOING 0702 

Z120 ZET SWE 0703 

TRA Z122 BACKWARDS 0704 

♦IF FORWARD, REVERSE SWE, READJUST IR4 AND DECREM OF TXI 0705 

Z121 CLA Kl 0706 

STO SWE 0707 

SXD TEMP, 4 RESET I^JE TO 2M-I^JE 0708 

CLA 2M 0709 

SUB TEMP 0710 

PDX 0,4 0711 

CLA MJE 0712 

STD Z100 0713 

♦IS COSP GO BACK, IF NOT REMAKE FORK AT Z105 0714 

Z121A NOP (TRA Z102CC0SP) ZET SWO ( SI SP ,COSI SP ) ) 0715 

TRA Z121B 0716 

CLA KA11 (KA11=»Z70) 0717 

STA Z105 0718 

TRA Z102 0719 

Z121B CLA KA12 (KA12=Z80) 0720 

STA Z105 0721 

TRA Z102 0722 

♦ IF BACKWARDS 0723 
Z122 STZ SWE 0724 

PXA 0,4 0725 

PAC 0,4 0726 

CLA JE 0727 

STD ZiOO 0728 

♦IF COSP GO BACK, IF NOT REMAKE FORK AT Z105 0729 

Z122A NOP (TRA Z102 (COSP), ZET SWO ( SI SP,COSI SP ) ) 0730 

TRA Z122B 0731 

CLA KA9 (KA9=Z50) 0732 

STA Z105 0733 

TRA Z102 0734 

Z122B CLA KA10 (KAI0=Z60) 0735 

STA Z105 0736 

TRA Z102 0737 

♦COSP OR COSISP RESULT STORAGE FOR COSINE TRANSFORMS 0738 

♦WAS LAST EVEN HARMONIC A DUMMY 0739 

Z107 ZET DUME 0740 

TRA Z109 YES 0741 

♦IF NOT STORE SMCE IN COSTR BLOCK 0742 

LXA EST0R,4 0743 

CLA SMCE 0744 

Z108 ADD •»,4 (♦♦=COSTR) 0745 

STO^ ^-l 0746 

♦WAS LAST ODD HARMONIC A DUMMY 0747 

Z109 ZET DUMO 0748 

TRA Z109B YES 0749 
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•IF NOT STORE SMCO IN COSTR BLOCK 0750 

LXA OSTOR, 4 0751 

CLA SMCO 0752 

Z109A ADD **,4 (♦♦-COSTR) 0753 

STO* »-l 0754 

Z109B TRA ♦♦ (♦♦=*Z115 COSISP, ♦♦*Z130 COSP) 0755 

♦COSISP OR SISP RESULT STORAGE FOR SINE TRANSFORMS 0756 

♦WAS LAST EVEN HARMONIC A DUMMY 0757 

Z115 ZET DUME 0758 

TRA Z117 YES 0759 

•IF NOT STORE SMSE IN SINTR BLOCK 0760 

LXA EST0R,4 0761 

CLA SMSE 0762 

ZU6 ADD ♦♦,4 l»« = SINTR) 0763 

STO* »-l 0764 

•WAS LAST ODD HARMONIC A DUMMY 0765 

Z117 ZET DUMO 0766 

TRA Z130 YES 0767 

•IF NOT STORE SMSO IN SINTR BLOCK 0768 

LXA OSTOR, 4 0769 

CLA SMSO 0770 

Z118 ADD »»,4 (♦♦=SINTR) 0771 

ST0» *-l 0772 

•RESET FOR NEXT LOOP STORAGE 0773 

Z130 CLA ESTOR 0774 

ADD K2 0775 

STO ESTOR 0776 

CLA OSTOR 0777 

ADD K2 0778 

STO OSTOR 0779 

•INDEX JE BY TWO AND CHECK IF TOO BIG 0780 

CLA JE 0781 

ADD KD2 0782 

STD JE 0783 

CAS T10 COMPARE WITH JMAX 0784 

TRA Z135 TOO BIG 0785 

NOP OK 0786 

•IF NEW JE OK, INDEX JO BY TWO AND CHECK ITS SIZE 0787 

Z131 CLA JO 0788 

ADD KD2 0789 

STD JO 0790 

CAS T10 0791 

TRA Z133 TOO BIG 0792 

Z131A NOP OK 0793 

♦RETURN TO BEGINNING OF LOOP 0794 

Z132 TRA Z30 0795 

♦IF JO TOO BIG SET SWITCH 0796 

Z133 CLA Ki 0797 

STO DUMO 0798 

♦IS JE ALSO TOO BIG 0799 

ZET DUME 0800 

TRA LV YES - ALL FINISHED 0801 

TRA Z132 NO - ONE MORE TO GO 0802 

♦IF JE TOO BIG SET SWITCH 0803 

Z135 CLA Kl 0804 

STO DUME 0805 

TRA Z131 GO CHECK JO 0806 

♦FINAL EXIT 0807 

LV LXD COSP-2,4 0808 

AXT (♦♦=IR1) 0809 

AXT *^,2 (♦♦=IR2) 0810 

EXIT TRA **,4 (♦♦=10 FOR COSP OR SISP, ♦♦=14 FOR COSISP) 0811 

♦CONSTANTS, TEMPORARIES, ETC 0812 

SWE PZE ♦♦ (**=0 WHILE EVEN HARMONIC GOING FORWARDS) 0813 

♦ (**=1 WHILE EVEN HARMONIC GOING BACKWARD) 0814 
SWO PZE ♦♦ (**=0 WHILE ODD HARMONIC FORWARDS) 0815 

♦ (♦♦^l WHILE ODD HARMONIC BACKWARDS) 0816 
JE PZE 0,0,** ♦♦^JE 0817 

MJE PZE 0,0, ♦* **=25 COMP OF JE 0818 

JO PZE 0,0, ♦* **=J0 0819 

MJO PZE 0,0,** ***25 COMP OF JO 0820 

DUME PZE ♦* (**=0 FOR REAL EVEN,*^=1 FOR DUMMY EVEN) 0821 

DUMO PZE ♦* (**=0 FOR REAL 0DD,*^=1 FOR DUMMY ODD) 0822 

ESTOR PZE ♦* <**=ZERO INDEX OF INITIAL EVEN HARMONIC STORAGE) 0823 

OSTOR PZE ♦* (**=ZERO INDEX OF INITIAL ODD HARMONIC STORAGE) 0824 



* COSP 
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MPY 


MPY 


»* 1 1 


FMP 


FMP 


»»t 1 


AOO 


AOO 


• » 


FAD 


FAD 


»# 


SMSE 


PZE 


** 


SMSO 


PZE 


*# 


SMCE 


PZE 


#•# 


SMCO 


PZE 


** 


2M 


PZE 


Of Of ** 


TEMP 


PZE 


** 


Tl 


PZE 


** 


T2 


PZE 




T3 


PZE 


»* 


T4 


PZE 




T5 


PZE 


Ot 0 1 ** 


T6 


PZE 


»♦ 


T7 


PZE 


** 


T8 


PZE 


Of 0 f «» 


T9 


PZE 


0 f Of ** 


TIO 


PZE 


Of Of ** 


Til 


PZE 


♦ # 


T 12 


PZE 




Tl 3 


PZE 


** 


KO 


PZE 


0 


Kl 


PZE 


1 


K2 


PZE 


2 


KIO 


PZE 


10 


K14 


PZE 


14 


KTi 


TRA 


Z104 


KT2 


TRA 


Z102 


KZi 


ZET 


SWE 


KZ2 


ZET 


SWO 


KOI 


PZE 


Of Of 1 


K02 


PZE 


Of Of 2 


KA2 


PZE 


SMSE 


KA3 


PZE 


SMSO 


KA4 


PZE 


SMCE 


KA5 


PZE 


SMCO 


KA6 


PZE 


Z90 


KA7 


PZE 


Z100 


KA8 


PZE 


Z30 


KA9 


PZE 


Z50 


KAIO 


PZE 


Z60 


KA11 


PZE 


Z70 


KA12 


PZE 


Z80 


KA13 


PZE 


KA8 


KA14 


PZE 


KA9 


KA15 


PZE 


Z107 


KA16 


PZE 


Z115 


KA17 


PZE 


Z120 


KA18 


PZE 


KA6 


KA19 


PZE 


Z130 




END 
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0825 
0826 
0827 
0828 

SUM FOR EVEN HARMONIC SINE TRANSFORM 0829 
SUM FOR ODO HARMONIC SINE TRANSFORM 0830 
SUM FOR EVEN HARMONIC COSINE TRANSFORM 0831 
SUM FOR 000 HARMONIC COSINE TRANSFORM 0832 
(♦*=2M) 0833 

0834 

(**=RSS) 0835 
(»»=RAS) 0836 
(***RSA) 0837 
(»*«RAA) 0838 
<»*=P) 0839 
<*»=C0STAB) 0840 
(»*«SINTAB) 0841 
<»*=M> 0842 
(**=JMIN) 0843 
<**=JMAX) 0844 
(**=TYPE) 0845 
(*»=COSTR) 0846 
(**=SINTR) 0847 



0848 
0849 
0850 
0851 
0852 
0853 
0854 
0855 
0856 
0857 
0858 
0859 
0860 
0861 
0862 
0863 
0864 
0865 
0866 
0867 
0868 
0869 
0870 
0871 
0872 
0873 
0874 
0875 
0876 
0877 
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» COSTBL i SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0199 

» FAP 0001 

•COSTBL 0002 

COUNT 200 0003 

LBL COSTBL 0004 

ENTRY COSTBL (N,CGSTAB) 0005 

ENTRY SINTBL (N,S INTAB) 0006 

ENTRY COSTBX (N,ICOSTB) 0007 

ENTRY SINTBX (N, ISINTB) 0008 

* 0009 

* ABSTRACT 0010 

* 0011 

* TITLE - COSTBL WITH SECONDARY ENTRY POINTS SINTBL, COSTBX, SINTBX 0012 

* GENERATE COSINE OR SINE HALF— WAVE TABLES, FIXED OR FLOATING 0013 

* 0014 

* COSTBL GENERATES A HALF-WAVE COSINE TABLE FLOATING POINT 0015 
» SINTBL GENERATES A HALF-WAVE SINE TABLE FLOATING POINT 0016 

* COSTBX GENERATES A HALF-WAVE COSINE TABLE FIXED POINT 0017 
» SINTBX GENERATES A HALF-WAVE SINE TABLE FIXED POINT 0018 

* WHERE 0019 

* THE HALF-WAVE LENGTH IS AN INPUT PARAMETER. 0020 
« FOR FIXED POINT TABLES THE BINARY POINT IS BETWEEN 0021 

* THE SIGN BIT AND BIT 1. 0022 

* 002 3 

* LANGUAGE - FAP SUBROUTINE I FORTRAN II COMPATIBLE) 0024 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0025 
» STORAGE - 121 REGISTERS 0026 

* SPEED - ABOUT 2N MILLISEC ON 709, WHERE N » HALF-WAVE LENGTH 0027 

* AUTHOR - JON CLAERBOUT 0028 

* 0029 

» USAGE 0030 

» 0031 

* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0032 
» AND FORTRAN SYSTEM ROUTINES - COS, SIN 0033 
» 0034 

* FORTRAN USAGE OF COSTBL 0035 
» CALL COSTBL(N,COSTAB) 0036 

* 0037 

* INPUTS TO COSTBL 0038 

* N DEFINES THE HALF-WAVE LENGTH TO BE N+l 0039 

* MUST EXCEED ZERO (PROGRAM EXITS IF N IS NEGATIVE OR ZERO) 0040 

* 0041 

* OUTPUTS FROM COSTBL 0042 

* COSTAB(I) I«l...N+l CONTAINS TABLE(J) = COS(J»PI/N) J=0,1,...,N 0043 

* I.E. COSTAB(I) CONTAINS TABLE(I-l) 0044 

* 0045 
« FORTRAN USAGE OF SINTBL 0046 
» CALL SINTBL (N,S INT AB ) 0047 

* INPUTS TO SINTBL 0048 

* N SAME MEANING AS FOR COSTBL 0049 
« OUTPUTS FROM SINTBL 0050 

* SINTAB(I) 1=1.. .N+l CONTAINS TABLE(J) = SIN(J*PI/N) FOR J=0,i...N 0051 
» 0052 
» FORTRAN USAGE OF COSTBX 0053 

* CALL COSTBX(N,ICOSTB) 0054 

* INPUTS TO COSTBX 0055 
» N SAME MEANING AS FOR COSTBL 0056 

* OUTPUTS FROM COSTBX 0057 

* ICOSTB(I) 1=1.. .N+l IS SAME AS FOR COSTBL BUT DATA IS FIXED POINT 0058 

* 0059 

* FORTRAN USAGE OF SINTBX 0060 

* CALL SINT8X(N, ISINTB) 0061 

* INPUTS TO SINTBX 0062 

* N SAME MEANING AS FOR COSTBL 0063 
» OUTPUTS FROM SINTBX 0064 

* ISINTB(I) 1=1. ..N+l IS SAME AS FOR SINTBL BUT DATA IS FIXED POINT 0065 

* 0066 

* EXAMPLES 0067 

* 1. GENERAL BEHAVIOR FOR N=4 0068 

* INPUTS - N=4 0069 
» USAGE - CALL COSTBL! N, COS TAB ) 0070 
» CALL SINTBL(N,SINTAB) 0071 

* CALL COSTBX(N,ICOSTB) 0072 

* CALL S1NTBX(N, ISINTB) 0073 

* OUTPUTS - NOTE - THESE NUMBERS ARE GOOD TO 8 OCTAL PLACES. 0074 
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• 




C0STABU...5) 


= 1.0, .70711,0.0, 


-.70711 


,-1.0 


0075 


» 




SI NTAB ( 1. • • 


5) 


» 0.0, .70711, 1.0, 


.70711, 


0.0 


0076 


• 




ICQSTBd... 


5) 


= OCT 377777777777,265011714000, 


0077 


* 








000000000000, 


665011714000, 77T777777777 


0078 


* 




ISINTBU... 


5) 


= OCT 000000000000,265011714000, 


0079 


* 








377777777777, 


265011714000,000000000000 


0080 


* 














0081 




HTR 


0 










0082 




BCI 


1, COSTBL 










0083 


COSTBL 


CLA 


» 










0084 




STO 


FL 










0085 




TRA 


#*3 










0086 


COSTBX 


STZ 


FL 










0087 




STZ 


CORS 










0088 




SXD 


COSTBL-2,4 










0089 




SXA 


SV,1 










0090 




CLA 


KCOS 




(TSX $C0S,4) 






0091 




STO 


AL 










0092 




CLA 


2,4 




GET COSINS 






0093 




STA 


B3 










0094 




ADD 


= 1 




COSINS+1 






0095 




STA 


A 










0096 




STA 


B 










0097 




STA 


Bl 










0098 




STA 


B2 










0099 




STA 


B4 










0100 




TRA 


D 










0101 


SINTBL 


CLA 


• 










0102 




STO 


FL 










0103 




TRA 


*+4 










0104 


SINTBX 


STZ 


FL 










0105 




CLA 


» 










0106 




STO 


CORS 










0107 




SXD 


COSTBL-2,4 










0108 




SXA 


SV,1 










0109 




CLA 


KSIN 




(TSX $SIN,4) 






0110 




STO 


AL 










0111 


* SET 


UP FIXING LOOP 










0112 




CLA 


2,4 




GET SINS 






0113 




ADD 


= 1 




SINS+1 






0114 




STA 


A 










0115 




STA 


B 










0116 




STA 


Bl 










0117 




STA 


B2 










0118 




STA 


L2 










0119 


* SET 


UP COMPUTATION LOOP 










0120 


D 


CLA» 


1,4 




GET N 






0121 




TZS 


SV 










0122 




TMI 


SV 










0123 




STD 


N 










0124 




ADD 


KD1 




FORM N+l 






0125 




STD 


AN 










0126 




STD 


BN 










0127 




CLA 


N 




FLOAT N 






0128 




ARS 


18 










0129 




ORA 


ORF 










0130 




FAD 


ORF 










0131 




STO 


NFL 










0132 




CLA 


=3.14159265 




FORM PI/N 






0133 




FDP 


NFL 










0134 




STQ 


INCR 










0135 




STZ 


ARG 










0136 


» LOOP 














0137 




AXT 


1,1 




COS 


SIN 




0138 




CLA 


ARG 










0139 


AL 


NOP 






TSX $C0S,4 


TSX 


$SIN,4 


0140 


A 


STO 


**,1 




»»=C0SINS+1 


♦*=SINS+1 


0141 




CLA 


ARG 










0142 




FAD 


INCR 










0143 




STO 


ARG 










0144 




TXI 


*+l,l,l 










0145 


AN 


TXL 


AL,1,»« 




♦*=N+1 






0146 




ZET 


FL 




FIX IF ZERO 






0147 




TRA 


SV 




EXIT - NOT ZERO 






0148 




AXT 


1,1 










0149 
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BC 


CLM 








0150 


B 


LOQ 


♦ *,1 


**=C0SINS+1 




0151 




LLS 


8 






0152 




SSP 








0153 




SUB 


=0200 






0154 




STA 


RTSH 






0155 


Bl 


CLA 


»*, 1 


»*=COSINS+i 




0156 




LRS 








0157 




ANA 


=0000777777777 




0158 




ALS 


8 






0159 




LLS 








0160 


RTSH 


ARS 


*» 


»* FROM B+4 




0161 


B2 


STO 


♦ **1 


**=C0SINS+1 




0162 




TXI 


♦♦1,1,1 






0163 


BN 


TXL 


BC f If *♦ 


**=N+1 




0164 




CLA 


CORS 






0165 




TNZ 


LI 






0166 




CLA 


=0377777777777 


SET FIRST AND 


0167 


B3 


STO 


#* 


**=COSINS 


LAST VALUES 


0168 




SSM 






IN TABLE = 1 


0169 




LXD 


BN, 1 






0170 


84 


STO 


**, 1 


»*=C0S INS+l 




0171 




TRA 


SV 






0172 


L 1 


CLA 


N 






01 73 




ARS 


18 






0174 




LBT 




IF ? Of N EVEN - 


EXI T 


0175 




TRA 


»+2 






0176 




TRA 


SV 






0177 




CLA 


N 


N ODD - SET MDPT 


= 1 


0178 




ARS 


1 


GET (N+D/2 




0179 




ADO 


KD1 






0180 




STD 


MD 






0181 




CLA 


=0377777777777 






0182 




LXD 


MO, I 






0183 


L2 


STO 




** = SINS+1 




0184 


SV 


AXT 


»* 1 1 






0185 




LXD 


C0STBL~2,4 






0186 




TRA 


3,4 






0187 


N 


PZE 


** 


*»=N IN OECR 




0188 


FL 


rLtz 


• « 


**=0,FXD 




0189 


INCR 


PZE 


• » 


**=PI/N. 




0190 


ARG 


PZE 


•* 


**=I*PI/N, 1=0, 


1,...,N 


0191 


ORE 


OCT 


233000000000 






0192 


NFL 


PZE 


** 


*»=FLOATF ( N ) 




0193 


KD1 


PZE 


0,0,1 






0194 


KCOS 


TSX 


$C0S,4 






0195 


KSIN 


TSX 


$SIN,4 






0196 


CORS 


PZE 


»* 


**=0 IF COS 




0197 


MD 


PZE 


0,0, ** 


**=(N+l>/2 




0198 




END 








0199 
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REFER TO REFER TO 

COSTBL COSTBL 
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» CPYFL2 (SUBROUTINE) 9/9/64 LAST CARO IN DECK IS NO. 0303 

» FAP 0001 

♦CPYFL2 0002 

COUNT 300 0003 

LBL CPYFL2 0004 

ENTRY CPYFL2 UTPINt ITPOUT, LRECMX, ZFEOFW, SPACE, IANS) 0005 

* 0006 

* ABSTRACT 0007 

» 0008 

* TITLE - CPYFL2 0009 

* FAST COPY FILE FROM ONE TAPE TO ANOTHER - VERSION 2 0010 
» 0011 
» CPYFL2 COPIES ONE FILE OF BCD AND/OR BINARY RECORDS FROM 0012 

* ONE TAPE TO ANOTHER TAPE. THE END— OF-F ILE MARK IS ALSO 0013 
» COPIED IF THE USER DESIRES IT. 0014 
» 0015 

* IF A REDUNDANCY IS ENCOUNTERED ON EITHER TAPE, CPYFL2 0016 

* WILL ATTEMPT TO RECOPY 20 TIMES BEFORE GIVING AN ERROR 0017 

* EXIT. AN ERROR EXIT WILL ALSO OCCUR IF AN END-TAPE 0018 

* CONDITION IS SENSED. 0019 

* 0020 
« CPYFL2 DERIVES ITS SPEED BY OPERATING BOTH TAPES 0021 

* SIMULTANEOUSLY IF THEY ARE ON DIFFERENT DATA CHANNELS. 0022 

* 0023 

* LANGUAGE - FAP SUBROUTINE (FORTRAN (II) COMPATIBLE) 0024 
» EQUIPMENT - 709, 7090, OR 7094 (MAIN FRAME AND TWO TAPE UN1TS1 0025 
» STORAGE - 178 REGISTERS 0026 
» SPEED - FOR THE 7090 (556 BPI) 0027 
» 0.00927 SECONDS/14 WORD RECORD IF THE TAPES ARE ON 0028 
« DIFFERENT CHANNELS. 0029 

* 0.01828 SEC0NDS/i4 WORD RECORD IF THE TAPES ARE ON 0030 

* THE SAME CHANNEL. 0031 

* (NOTE THAT FORTRAN COPYING (READING ONE RECORD AND THEN 0032 
» WRITING ONE RECORD) REQUIRES 0.02845 SECONDS/PER 14 WORD 0033 
» RECORD. ) 0034 

* AUTHOR R.A. WIGGINS JULY, 1964 0035 

* 0036 

» USAGE 0037 

» 0038 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0039 

* AND FORTRAN SYSTEM ROUTINES - UOS), (TCO), (WRS), ( RCH) , ( TRC ) , 0040 

* (ETT), (WEF), (BSR), (RDS) 0041 

* 0042 

* FORTRAN USAGE 0043 

* CALL CPYFL2( ITPI N, I TPOUT ,LRECMX , ZFEOFW , SPACE, IANS) 0044 

* 0045 
» INPUTS 0046 
» 0047 

* ITPIN LOGICAL TAPE NUMBER THAT FILE IS COPIED FROM. 0048 

* 0049 

* ITPOUT LOGICAL TAPE NUMBER THAT FILE IS TO BE COPIED ONTO. 0050 
» 0051 

* LRECMX MAXIMUM NUMBER OF WORDS PER RECORD THAT WILL BE COPIED. 0052 

* IF RECORDS ARE ENCOUNTERED THAT ARE LONGER, THEY WILL 0053 

* BE CHOPPED AT THIS LENGTH AND THE REMAINING WORDS WILL 0054 

* BE LOST. 0055 
» SOME STANDARD FORTRAN RECORD LENGTHS ARE 0056 

* BCD CARDS - 14 WORDS 0057 

* BCD OUTPUT RECORDS - 22 WORDS 0058 

* BINARY CARDS - 27 WORDS 0059 

* BINARY OUTPUT RECORDS - 256 WORDS 0060 

* MUST BE GRTHN I BUT IS NOT CHECKED. 0061 

* 0062 

* ZFEOFW IS ZERO IF AN END-OF-F ILE IS TO BE WRITTEN ON ITPOUT. 0063 
» IS NOT ZERO IF NO END-OF-F ILE IS TO BE WRITTEN. 0064 

* 0065 
» SPACE(I) 1*1,..* ,2»LREC IS TEMPORARY STORAGE SPACE NEEDED BY 0066 

* CPYFL2. 0067 

* 0068 

* OUTPUTS 0069 

* 0070 
» ONE FILE FROM TAPE ITPIN IS COPIED ONTO ITPOUT. ITPIN IS LEFT 0071 

* POSITIONED AFTER THE END-OF-F I LE MARK AND ITPOUT IS LEFT 0072 

* POSITIONED AFTER THE END-OF-F I LE MARK IF ZFEOFW * 0., OR AFTER 0073 
» THE LAST RECORD COPIED IF ZFEOFW NOT* 0. IF A PERMANENT 0074 
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* REDUNDANCY IS ENCOUNTERED ON ITPIN, IT IS LEFT POSITIONED AFTER THE 0075 

* REDUNDANT RECORD AND ITPOUT IS LEFT POSITIONED AFTER THE PREVIOUS 0076 

* RECORD. IF A PERMANENT REDUNDANCY IS ENCOUNTERED ON ITPOUT, ITPIN 0077 
» IS LEFT POSITIONED AFTER THE RECORD IMMEDIATELY SUCCEEDING THE 0078 
» REDUNDANT RECORD AND ITPOUT IS LEFT POSITIONED AFTER THE REDUNDANT 0079 

* RECORD. IF AN END-TAPE CONDITION IS SENSED ON ITPIN, ITPOUT IS 0080 
» LEFT POSITIONED AFTER THE LAST SUCCESSFULLY READ RECORD. IF AN 0081 

* END-TAPE CONDITION IS SENSED ON ITPOUT, ITPIN IS LEFT POSITIONED 0082 

* ONE RECORD BEYOND THE LAST RECORD SUCCESSFULLY COPIED. 0083 
« 0084 
» SPACEU> CONTAINS THE NUMBER OF RECORDS COPIED IN THIS FILE 0085 

* (FIXED POINT). 0086 

* 0087 

* IANS * 0 IF ALL OK. 0088 

* = 1 IF REDUNDANCY ON ITPIN (AFTER 20 ATTEMPTS TO RECOPY). 0089 

* = 2 IF REDUNDANCY ON ITPOUT (AFTER 20 ATTEMPTS TO RECOPY) 0090 
» * 3 IF REDUNDANCIES ON ITPIN AND ITPOUT (AFTER 20 0091 

* ATTEMPTS TO RECOPY). 0092 
» =4 IF END TAPE ON ITPIN. 0093 

* - 5 IF END TAPE AND REDUNDANCY ON ITPIN. 0094 

* * 6 IF END TAPE ON ITPIN, REDUNDANCY ON ITPOUT. 0095 

* = 7 IF END TAPE ON ITPIN, REDUNDANCIES ON ITPIN AND 0096 

* ITPOUT. 0097 
« 2 8 IF END TAPE ON ITPOUT. 0098 
» * 9 IF END TAPE ON ITPOUT, REDUNDANCY ON ITPIN# 0099 
» =10 IF END TAPE AND REDUNDANCY ON ITPOUT. 0100 
» =11 IF END TAPE ON ITPOUT, REDUNDANCIES ON ITPIN AND 0101 

* ITPOUT. 0102 
» =12 IF END TAPE ON ITPIN AND ITPOUT. 0103 

* =13 IF END TAPE ON ITPIN AND ITPOUT, REDUNDANCY ON ITPIN. 0104 

* =14 IF END TAPE ON ITPIN AND ITPOUT, REDUNDANCY OF ITPOUT 0105 

* =15 IF END TAPE AND REDUNDANCIES ON ITPIN AND ITPOUT. 0106 

* 0107 
» 0108 

* EXAMPLE 0109 

* 0110 

* 1. A COMPREHENSIVE TEST - END— OF-F ILE CONTROL AND COPYING 0111 

* ALTERNATING BCD AND BINARY RECORDS. 0112 
» INPUTS - ITPIN = 6 ITPOUT = 8 LRECMX = 10 2FE0F1 = U 0113 

* IAU...5) = 1,2,3,4,5 ZFE0F2 * 0. 0114 
» USAGE - C SET UP ITPIN WITH ALTERNATING BCD AND BINARY RECORDS. 0115 

* REWIND ITPIN 0116 

* WRITE OUTPUT TAPE ITPIN, 10, I A( 1 ) 0117 

* 10 F0RMAT(5I6) 0118 

* WRITE TAPE ITPIN, ( I A( I ) , 1= 1, 3) 0119 

* WRITE OUTPUT TAPE ITPIN, 10, ( IA( I) , 1=1, 5) 0120 
» END FILE ITPIN 0121 

* REWIND ITPIN 0122 

* REWIND ITPOUT 0123 
» C COPY THE FILE TWICE 0124 

* CALL CPYFL2( ITPIN, I T POUT, LRECMX t 2F EOF 1, SPACE, I ANSI 0125 

* REWIND ITPIN 0126 

* CALL CPYFL2(ITPIN,ITP0UT, LRECMX, ZFE0F2, SPACE, IANS) 0127 

* C READ THE FILE FROM ITPOUT (LAST READ SHOULD CAUSE EXIT) 0128 
» REWIND ITPOUT 0129 
» READ INPUT TAPE ITPOUT, IB(1) 0130 
» READ TAPE ITPOUT, UB( I ), 1=2,4) 0131 
» READ INPUT TAPE ITPOUT, ( IB( I ), 1=5, 101 0132 
» READ TAPE ITPOUT, ( I8( I ), 1=11, 13) 0133 

* READ INPUT TAPE ITPOUT, ( IBU >, 1 = 14, 18) 0134 

* READ INPUT TAPE ITPOUT, IB( 19) 0135 

* OUTPUTS - IANS = 0 IBU...18) = 1, 1,2,3, 1,2,3,4,5, 0136 
» 1, 1,2,3, 1,2,3,4,5 0137 

* 0138 
» 0139 
» PROGRAM FOLLOWS BELOW 0140 

* 0141 
XR4 HTR 0 0142 

BCI 1,CPYFL2 0143 

CPYFL2 SXD XR4,4 SAVE 0144 

SXA IRl,l INDEX 0145 

SXA IR2,2 REGISTERS. 0146 

CLA 11 SAVE 0147 

STO NIF1 TRAPPING 0148 

CLA 13 INSTRUCTIONS. 0149 



••»••»»*»»••»•»••*•»**»* PROGRAM LISTINGS #**«»•***»• 

♦ CPYFL2 * * CPYFL2 



(PAGE 3) (PAGE 3) 

STO NIF2 0150 

AXT 20,2 0151 

CLA* 4,4 0152 

STO WEFSW 0153 

CLA* 3,4 0154 

STD IN 0155 

PDX ,1 0156 

SXA LREC* I 0157 

CAL 5,4 CHANNEL 0158 

ADD = 1 0159 

SUB LREC COMMANDS. 0160 

STA IN 0161 

SUB LREC 0162 

STA UT 0163 

AXT 0,1 0164 

TP SET LXD XR4,4 0165 

CLA» 2,4 GET OUTPUT TAPE NO. (ITPOUT) 0166 

ZET MODE TEST FOR 0167 

ADD =020 BINARY MODE 0168 

TSX $U0S),4 SET UP INSTRUCTIONS IN (IOS) 0169 

LXD XR4,4 RESTORE IR 4. 0170 

LDQ* $(TCO) SET UP 0171 

SLQ TCOA INSTRUCTIONS 0172 

LDQ* $(WRS) BY 0173 

STQ WRSA A. 0174 

LDQ* $(RCH) 0175 

SLQ RCHA 0176 

LDQ* $<TRC) 0177 

SLQ TRCA 0178 

LDQ* $( ETT ) 0179 

STQ ETTA 0180 

LDQ* $(WEF) 0181 

ZET WEFSW 0182 

LDQ NOP 0183 

STQ WEFA 0184 

LDQ* S(BSR) 0185 

STQ BSRA1 0186 

CLA* 1,4 GET INPUT TAPE NO. (ITPIN) 0187 

ZET MODE TEST FOR 0188 

ADD =020 BINARY MOOE. 0189 

TSX $(I0S),4 SET UP INSTRUCTIONS IN (IOS). 0190 

LDQ* $(TCO) SET 0191 

SLQ TCOB UP 0192 

SLQ TC0B1 0193 

SLQ TC082 0194 

LDQ* $(RDS) INSTRUCTIONS 0195 

STQ RDSB DESIGNATED 0196 

LDQ* $(BSR) 0197 

STQ BSRB1 0198 

STQ BSRB2 0199 

LDQ* $(RCH) BY 0200 

SLQ RCHB 8. 0201 

CLA SCHB 0202 

LLS 0 0203 

XCA 0204 

SLQ SCHB 0205 

LDQ* $( ETT ) 0206 

STQ ETTB 0207 

XCL 0208 

ANA =03000 0209 

ARS 9 0210 

PAX ,4 0211 

SXD ENBIN,4 0212 

SXA ENBIN,4 0213 

ALS 1 0214 

ADD =8B35 0215 

STA ICB 0216 

CLA TRA2 STORE 0217 

STO 11 TRAPPING 0218 

STO 13 INSTRUCTIONS. 0219 

TCOB TCOB * DELAY IF CHANNEL IN OPERATION. 0220 

RDSB RTDB ** READ SELECT. 0221 

ENS ENBIN ENABLE INPUT DATA CHANNEL. 0222 

RCHB RCHB IN RESET AND LOAD CHANNEL. 0223 

SCHB SCHB DC MONITOR 0224 
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TRA 


»-l 


READING PROCESS, 


0225 


ICB 


LXD 


**,4 


♦REENTRY FROM TRAP. 


0226 




ENB 


=0 


DISENABLE CHANNELS FOR OUTPUT. 


0227 




TRA 


TRAi+1,4 


CHECK 


0228 




TRA 


ENDFIL 




0229 




TRA 


ENDFIL 




0230 




TRA 


ENDFIL 




0231 




TRA 


ENDFIL 


REASON 


0232 




TRA 


REDUNB 


FOR 


0233 




TRA 


REDUNB 


TRAPPING. 


0234 


TRA1 


CLA 


=077777 


END RECORD. 


0235 




ANS 


DC 


SWITCH 


0236 




LDQ 


IN 


INPUT 


0237 




CLA 


UT 


AND 


0238 




STA 


IN 


OUTPUT 


0239 




XCA 






0240 




STA 


UT 


ADDRESSES. 


0241 




ANA 


=077777 


FIND 


0242 




SUB 


DC 


NO. 


0243 




ALS 


18 


OF 


0244 




STD 


UT 


WORDS IN REC. 


0245 




AXT 


20,2 




0246 




PXD 


tO 


CHECK 


0247 


ETT8 


ETTB 




FOR 


0248 




ADD 


=4B17 


REDUNDANCY ON ITPOUT 


0249 


TCOA 


TCOA 


» 




0250 


TRCA 


TRCA 


REDUNA 


OR 


0251 


ETTA 


ETTA 




END TAPE 


0252 




ADD 


=8B17 


CONDITIONS 


0253 




TMI 


WEFA 


GO WRITE END-OF-FILE ON ITPOUT. 


0254 




TNZ 


END 


LEAVE IF END TAPE OF END OF FILE) 


0255 


WRSA 


WTDA 


•* 


WRITE THIS 


0256 


RCHA 


RCHA 


UT 


RECORD. 


0257 




TXI 


TCOB, 1,1 


BUMP RECORD COUNTER AND GO TO NEXT REC 


0258 


REDUNA 


ADD 


=2817 


SIGNAL ITPOUT REDUNDANCY 


0259 




TNX 


END, 2,1 


SLICE REDUNDANCY COUNTER 


0260 


TCOB2 


TCOB 


* 




0261 


BSR82 


BSRB 


»* 




0262 


BSRA1 


BSRA 


** 


PREPARE TO RETRY WRITING 


0263 




TRA 


TCOBl 




0264 


ENDFIL 


CLS 


= 1817 




0265 




TRA 


ETTB 




0266 


WEFA 


WEFA 


• » 


NOP IF ZFEOFW NOT= 0. 


0267 




CLA 


= 1 


SIGNAL TO LEAVE AFTER WRITING 


0268 




TRA 


TCOA 


CHECK FOR END TAPE 


0269 


REDUNB 


CLA 


= 1817 


SIGNAL ITPIN REDUNDANCY 


0270 




TNX 


ETTB, 2,1 


SLICE REDUNDANCY COUNTER 


0271 




CLA 


MODE 


CHANGE 


0272 




ADD 


= 1 


MODE 


0273 




ANA 


= 1 


AND 


0274 




STO 


MODE 


PREPARE TO 


0275 


TCOBl 


TCOB 


• 


RETRY READING 


0276 


BSRBl 


BSRB 


»» 


IN ANOTHER MODE 


0277 




TRA 


TPSET 




0278 


END 


LXD 


XR4,4 


RESET IR 4. 


0279 




STD* 


6,4 


SET IANS, AND 


0280 




CLA 


NIF1 


RESTORE 


0281 




STO 


13 


TRAPPING 


0282 




CLA 


NIF2 


INSTRUCTIONS 


0283 




STO 


14 




0284 




PXD 


tl 




0285 




STO* 


5,4 




0286 


IR1 


AXT 


**,1 




0287 


IR2 


AXT 


**,2 




0288 




TRA 


7,4 




0289 


TRA2 


TRA 


ICB 




0290 










0291 


NOP 


NOP 






0292 


MODE 


PZE 






0293 


NIF1 


PZE 






0294 


NIF2 


PZE 






0295 


LREC 


PZE 






0296 


IN 


IORT 


**t ,*« 




0297 


UT 


IORT 


** , , ** 




0298 


ENBIN 


PZE 


0 




0299 
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DC PZE 
WEFSW PZE 



END 



0300 
0301 
0302 
0303 
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♦ CROSS (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0086 

• LABEL 0001 
CCROSS 0002 

SUBROUTINE CROSS (LX,X,LY, Y,LC,C ) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - CROSS 0007 

C CROSSCORRELATION OF TRANSIENTS BEGINNING WITH ZERO LAG 0008 

C 0009 

C CROSS FINDS THE CROSSCORRELATION OF TRANSIENTS 0010 

C BEGINNING WITH ZERO LAG. 0011 

C 0012 

C LX 0013 

C CCK+1) * SUM ( XII) * YU-K) ) 0014 

C 1*1 0015 

C 0016 

C FOR K = 0,...,LC 0017 

C 0018 

C WHERE X AND Y ARE TRANSIENT SERIES OF LENGTH LX AND LY 0019 

C RESPECTIVELY, AND LC IS AN INPUT PARAMETER. THE COMPU- 0020 

C TATION IS MADE AS THOUGH X AND Y HAD ZEROS EXTENDING 0021 

C BEYOND THEIR ENDS. 0022 

C 0023 

C LANGUAGE - FORTRAN II SUBROUTINE 0024 

C EQUIPMENT - 709 OR 7090 i MAIN FRAME ONLY) 0025 

C STORAGE - 107 REGISTERS 0026 

C SPEED - 0027 

C AUTHOR - R.A. WIGGINS 0028 

C 0029 

C USAGE 0030 

C 0031 

C TRANSFER VECTOR CONTAINS ROUTINES - FDOT, STZ 0032 

C AND FORTRAN SYSTEM ROUTINES - NONE 0033 

C 0034 

C FORTRAN USAGE 0035 

C CALL CROSS «LX, X ,LY, Y, LC,C ) 0036 

C 0037 

C INPUTS 0038 

C 0039 

C LX LENGTH OF X SERIES. 0040 

C 0041 

C X(I) 1=1,. ..,LX IS THE X TRANSIENT SERIES. 0042 

C 0043 

C LY LENGTH OF Y SERIES. 0044 

C 0045 

C Yd) 1 = 1,.. .,LY IS THE Y TRANSIENT SERIES. 0046 

C 0047 

C LC IS THE DESIRED LENGTH OF THE CROSSCORRELATION. 0048 

C 0049 

C NOTE — IF LC, LX, OR LY ARE LESS THAN 1, THE ROUTINE EXITS WITH 0050 

C NO COMPUTATION. 0051 

C 0052 

C OUTPUTS 0053 

C 0054 

C CU) 1 = 1,... ,LC IS THE CROSSCORRELATION SERIES. THIS VECTOR 0055 

C IS SET TO ZERO BEFORE COMPUTATIONS ARE MADE. 0056 

C 0057 

C EXAMPLES 0058 

C 0059 

C 1. INPUTS - LX=3 XU...3) = l.,2.,3. LY = 2 Yd. ..2) * 2.,1. 0 0060 

C LC=5 CU...5) = .l,.l,.l,.l,.l 0061 

C OUTPUTS - CU...5) = 4.,7.,6.,0.,0. 0062 

C 0063 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT LC=2 0064 

C OUTPUTS - CU...5) = 4. ,7. I 0065 

C 0066 

C 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT LC=0 0067 

C OUTPUTS - CI1...5) = .l,.l,.l,.i,.l 0068 

C 0069 

C 4. INPUTS - SAME AS EXAMPLE 1. EXCEPT LX=0 0070 

C OUTPUTS - CU...5) = 0.,0.,0.,0.,0. 0071 

C 0072 

C 5. INPUTS - SAME AS EXAMPLE 1. EXCEPT LY=0 0073 
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C OUTPUTS - CU...5) * 0.,0.,0.,0.,0, 0074 

C 0075 

C PROGRAM FOLLOWS BELOW 0076 

C 0077 

DIMENSION X(2) ,Y(2),C(2> 0078 

IF (LC) 30,30,10 0079 

10 CALL STZ (LC,C> 0080 

IF (XMINOF(LX,LY) ) 30,30,15 0081 

15 LCl^XMINOF ( LX, LC ) 0082 

DO 20 1*1, LCI 0083 

20 CALL FOOT ( XMI NOF ( LY + I-i , LX )- 1+1 , X ( I ) , Y, C( I ) ) 0084 

30 RETURN 0085 

END 0086 
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» CROST (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0098 

« LABEL 0001 

CCROST 0002 

SUBROUTINE CROST ( LX, XX, LY , YY, K, LC, CC ) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - CROST 0007 

C 0008 

C CROSSCORRELATION OF TRANSIENTS BEGINNING WITH ANY LAG 0009 

C 0010 

C CROST FINDS LC TERMS OF THE CROSSCORRELATION CU) OF TWO 0011 

C TRANSIENTS X{ I ) AND YU ) OF LENGTH LX AND LY RESPECTIVELY 0012 

C BEGINNING WITH ANY LAG K 0013 

C 0014 

C LX 0015 

C CU) = SUM ( X(I) * YU-J) ) 0016 

C 1=1 0017 

C 0018 

C FOR J = K,...,K*LC-1 0019 

C 0020 

C WHERE THE COMPUTATION IS MADE AS THOUGH X AND Y HAD ZEROS 0021 

C EXTENDING BEYOND BOTH ENDS. 0022 

C 002 3 

C LANGUAGE - FORTRAN II SUBROUTINE 0024 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0025 

C STORAGE - 134 REGISTERS 0026 

C SPEED - 0027 

C AUTHOR - R.A. WIGGINS 0028 

C 0029 

C USAGE 0030 

C 0031 

C TRANSFER VECTOR CONTAINS ROUTINES - CROSS, REVERS 0032 

C AND FORTRAN SYSTEM ROUTINES - NONE 0033 

C 0034 

C FORTRAN USAGE 0035 

C CALL CROST ( LX,XX,LY,YY,K,LC,CC ) 0036 

C 0037 

C INPUTS 0038 

C 0039 

C LX IS LENGTH OF XX. 0040 

C IF LSTHN 1 NO COMPUTATION IS MADE. 0041 

C 0042 

C XX(I) 1=1,... ,LX CONTAINS X( 1 ),..., X ( LX ) AS DESCRIBED IN THE 0043 

C ABSTRACT. 0044 

C 0045 

C LY IS LENGTH OF YY. 0046 

C IF LSTHN 1 NO COMPUTATION IS MADE. 0047 

C 0048 

C YYU) 1 = 1,... ,LY CONTAINS Y( 1 ),..., Y( LY ) AS DESCRIBED IN THE 0049 

C ABSTRACT. 0050 

C 0051 

C K IS THE INITIAL LAG. 0052 

C 0053 

C LC IS THE NUMBER OF LAGS WANTED. 0054 

C IF LSTHN 1 NO COMPUTATION IS MADE. 0055 

C 0056 

C OUTPUTS 0057 

C 0058 

C CC(I) 1=1,... ,LC CONTAINS C ( K) , . . . , C ( K+LC-1 ) AS DESCRIBED IN 0059 

C THE ABSTRACT. 0060 

C 0061 

C EXAMPLES 0062 

C 0063 

C 1. INPUTS - LX = 3 XX(1...3) = l.,2.,3. LY=2 YYU. ..2) = 2., I. 0064 

C LC = 5 CCU.. .5) = .l,.l,.l,.l,.l K=0 0065 

C OUTPUTS - CCU. ..5) = 4. , 7. , 6. , 0. , 0. 0066 

C 0067 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT K=2 0068 

C OUTPUTS - CCU. ..5) = 6. , 0. , 0. ,0. , 0. 0069 

C 0070 

C 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT K=-2 0071 

C OUTPUTS - CCU. ..5) = 0. , 1 . , 4. , 7. , 6. 0072 

C 0073 

C 4. INPUTS - LX=2 XXU...2) = 2.,1. LY=3 YYU... 3) « l.,2.,3. 0074 
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C L05 CCU...5) * .1, .li.lt.h.l K--2 0075 

C OUTPUTS - CCU...5) = 6. ,7. ,4,, l.,0. 0076 

C 0077 

C 5. INPUTS - SAME AS EXAMPLE 4. EXCEPT LX = 0 0078 

C OUTPUTS - CCU...5) = 0. , 0. , 0. , 0. » 0. 0079 

C 0080 

C 6. INPUTS - SAME AS EXAMPLE 4. EXCEPT LY=0 0081 

C OUTPUTS - CC(l. ..5) = 0. ,0. f 0. ,0. ,0. 0082 

C 0083 

C 7. INPUTS - SAME AS EXAMPLE 4. EXCEPT LC=*0 0084 

C OUTPUTS - CC(1. ..5) = . 1 , . 1 , . 1 ♦ . I . . 1 0085 

C 0086 

C PROGRAM FOLLOWS BELOW 0087 

C 0088 

DIMENSION XX(2)*YY(2)*CC(2) 0089 

I l^XMAXOF ( 1 ,~K-LC+1 ) 0090 

LC1=XMIN0F(LC,-K) 0091 

CALL CROSS (LY-U,YY(IH-1) , LX , XX , LC 1 1 CC ) 0092 

CALL REVERS(LC1,CC) 0093 

I1=XMAX0F<0, K)+l 0094 

I2*XMAX0F(1,LCH-1) 0095 

CALL CROSS ( LX-I 1+ 1 , XX ( ID » LY f YY f LC-I 2 + 1 » CC ( 12) ) 0096 

RETURN 0097 

END 0098 
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9/10/64 LAST CARD IN DECK IS NO. 



* CRSVM (SUBROUTINE) 

* LABEL 
CCRSVM 

SUBROUTINE CRSVM ( NRAC, NCARB, NCBC, LAA, AA,LBB, BB,ZFNBTR, 
I IFSTLG, LCC, CC) 



ABSTRACT 

- CRSVM 

CROSSCORRELATION OF TRANSIENT VECTORS OF MATRICES. 

CRSVM FINDS LCC TERMS OF THE TRANSIENT CROSSCORRELATION 
OF A VECTOR OF NRAC X NCARB MATRICES Ail) WITH A 
VECTOR OF NCARB X NCBC MATRICES (AFTER TRANSPOSITION) 
B(K) BEGINNING WITH A FIRST LAG IFSTLG 



OR 



C( J) = 



C( J) = 



INF 

SUM ( A(I)*B(I-J) ) 
I=-INF 

INF 

SUM ( A(l)*B(I-J) ) 

I=-INF 



FOR 



IFSTLG, IFSTLG+l,..., IFSTLG+LCC-l 



C 
C 
C 

C TITLE 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

C LANGUAGE - FORTRAN II (SUBROUTINE) 

C EQUIPMENT - 709 t 7090, OR 7094 (MAIN FRAME ONLY) 

C STORAGE - 327 REGISTERS 

LET MD3TIM(NRAC, NCARB, NCBC, LAA) » TIME FOR MD0T3 
TO FIND THE DOT PRODUCT OF 2 SERIES OF LENGTH LAA. 
THEN TIME FOR ONE LAG OF A CROSS CORRELATION IS 
( MD3T I M( NRAC, NCARB, NCBC, LAA) 
+ .00085 - MD3TIM( 1,1,1,1)) SECONDS 
ON THE 7094 MOD 1 . 

FOR THE 3/63 VERSIONS OF MD0T3 AND MATML3 THIS 
BECOMES 

(.000036*NRAC*NCARB»NCBC + .000170*NRAC*NCBC 
+ .000040*NCBC ♦ .000024) * LAA ♦ .00010 SECONDS. 
THUS THE TIME FOR HALF OF MXL AGS LAGS OF AN 
AUTOCORRELATION OF A SERIES OF LENGTH LAA 
WILL BE ABOUT 

(.000036*NRAC*NCARB*NCBC ♦ .000170*NRAC*NCBC 
+ .000040*NCBC + .000024) 
* ( (LAA* ( L AA-MXLAGS ) ) /2 + .00010) * MXLAGS SECONDS. 
- R.A. WIGGINS AUGUST, 1964 



WHERE INF = INFINITY, B(I) = B(I) TRANSPOSE, AND THE 
ASSUMPTION IS MADE THAT THE VECTORS ARE ZERO BEYOND THE 
RANGE OF DEFINITION. 



C SPEED 
C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

C AUTHOR 
C 
C 



USAGE— 



MD0T3, SETKS, 
(NOT ANY) 



STZ 



C 

C TRANSFER VECTOR CONTAINS ROUTINES 
C AND FORTRAN SYSTEM ROUTINES 

C 

C FORTRAN USAGE 

C CALL CRSVM ( NRAC , NCARB , NCBC , LAA, AA, LBB, BB , ZFNBTR, IFSTLG, LCC ,CC ) 

C 

C INPUTS 
C 



NRAC 
NCARB 

NCBC 
LAA 



NUMBER OF ROWS IN THE 
MUST EXCEED ZERO. 



AA AND CC MATRICES. 



NUMBER OF COLUMNS IN THE AA MATRICES, NUMBER OF ROWS 

(AFTER TRANSPOSITION) IN THE BB MATRICES. 
MUST EXCEED ZERO. 



NUMBER OF COLUMNS IN THE 
MUST EXCEED ZERO. 



BB AND CC MATRICES. 



NUMBER OF NRAC X NCARB MATRIX ELEMENTS IN THE VECTOR OF 
MATRICES AA. 



0219 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
Q071 
0072 
0073 
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C MUST EXCEED ZERO* 0074 

C 0075 

C AA ( I ) I~l , ... , NRAC*NCARB*LAA CONTAINS THE VECTOR OF MATRICES 0076 

C Ad) A(LAA) STOREO CLOSELY SPACEO BY COLUMNS. 0077 

C 0078 
C LBB NUMBER OF NCARB X NCBC MATRIX ELEMENTS IN THE VECTOR OF 0079 

C MATRICES BB. 0080 

C MUST EXCEED ZERO. 0081 

C 0082 

C BBU) I=1,...,NCARB*NCBC*LBB CONTAINS THE VECTOR OF MATRICES 0083 

C 8(1) ,...,B(LBB) STORED CLOSELY PACKED BY COLUMNS (IF 0084 

C ZFNBTR=0.) OR BY ROWS (IF ZFNBTR=1. ) • 0085 

C 0086 

C ZFNBTR »0. IMPLIES THAT THE MATRICES IN BB( I ) ARE STORED BY 0087 

C COLUMNS* 0088 

C =1. IMPLIES THAT THE MATRICES IN BB( I ) ARE STORED BY 0089 

C ROWS. 0090 

C 0091 

C IFSTLG INDEX OF THE FIRST LAG OF THE CROSSCORRELAT ION. 0092 

C 0093 

C LCC NUMBER OF LAGS OF THE CROSSCORRELAT ION TO BE COMPUTED. 0094 

C MUST EXCEED ZERO. 0095 

C 0096 

C OUTPUTS 0097 

C 0098 

C STRAIGHT RETURN WITH NO COMPUTATIONS IF NRAC, NCARB, NCBC, 0099 

C LAA, LBB, OR LCC LSTHN^ 0. 0100 

C 0101 

C CC(I) I=1,...,NRAC*NCBC»LCC CONTAINS THE CROSSCORRELATION 0102 

C VECTOR OF MATRICES C( IFSTLG) ,C( IFSTLGHXC-1 ) AS 0103 

C DEFINED IN THE ABSTRACT STORED CLOSELY SPACED BY 0104 

C COLUMNS. 0105 

C 0106 

C EXAMPLES 0107 

C 0108 

C 1. INPUTS - NRAC=1 NCARB=2 NCBC*3 0109 

C LAA=4 AA{1...8)=(l.,2.),(3.,-2.),(5.t-4.)*(l.,-l.) 0110 

C LBB=2 BB(1...12)=( 3., 4., 1.) (-2. ,-2., 4.) 0111 

C ( 2., 3.,-i.), (-3., 2. ,-5.) 0112 

C (NOTE THAT BB IS STORED AS ) 0113 

C ( BB(1...12)=3.,2.,4.,3.,l.,-l.,-2.,-3.,-2.,2.,4.,-5. ) 0114 

C ZFNBTR=0. IFSTLG=-2 LCC=7 0115 

C OUTPUTS - CC(1..^21)= (0,0,0), (-8. , 2. ,-6. J , (-7. ,0. #21. ! , 0116 

C (7. ,-12. ,45. ), (8. ,4. ,18.), (l.,l.,2.), (0,0,0) 0117 

C 0118 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT ZFNBTR'l. - THIS CAUSES 0119 

C CRSVM TO SEE THE ARRAY BB(I) AS 3X2 MATRICES 0120 

C BB(1...12)»(3., 3.) (-2., 2.) 0121 

C (2., 1.) (-3., 4.) 0122 

C (4.,-!.), (-2. ,-5.) 0123 

C OUTPUTS - CC(1...21)= (0,0,0), ( 2. , 5. ,-12. ) , (-1 . ,-13. , 6. ) , 0124 

C (-15. ,-27. ,24.), (-l.,-l.,27.), (0.,1.,5.), (0,0,0) 0125 

C 0126 

C 0127 

C PROGRAM FOLLOWS BELOW 0128 

C 0129 

C 0130 

C 0131 

C DUMMY DIMENSION 0132 

C 0133 

DIMENSION AA(2),BB(2),CC(2) 0134 

C 0135 

C BRING IN PARAMETERS AND SET SOME USEFUL COMBINATIONS 0136 

C 0137 

CALL SETKS ( NRAC ,N, NCARB, M, NCBCL, LAA, LA, LBB, LB, 0138 

1 IFSTLG, K, LCCLC, 1,ICC) 0139 

NM=N*M 0140 

NL-N*L 0141 

ML-M*L 0142 

C 0143 

C LEAVE IF ANY VALUES ILLEGAL 0144 

C 0145 

IF ( XMI NOF (N,M,L,LA,LB,LC) ) 100,100,10 0146 

10 CONTINUE 0147 

C 0148 
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C CLEAR THE OUTPUT AREA 
C 

CALL STZ (LC*NL,CC) 

C 

C IF NEGATIVE LAGS ARE SPECIFIED DO THESE FIRST 
C 

IF (K) 20,50,50 
20 CONTINUE 

C 

C SET UP MD0T3 CONTROL PARAMETERS 
C 

IC IS MATRIX INDEX -1 OF NEXT OUTPUT 
ICC IS VECTOR INDEX OF NEXT OUTPUT 
LCM IS MATRIX NO. OF PRODUCTS TO COMPUTE 
IB IS MATRIX INDEX -I OF BB FOR NEXT PRODUCT 
IBB IS VECTOR INDEX OF BB FOR NEXT PRODUCT 



IC = XMAX0F(0,-K-LB+1) 
ICC * IC*NL+1 

LCM = XMIN0F(-K,LB-1,LC-IC) 
IB = XMIN0F(-K,LB-1) 
IBB * IB*ML+1 

C 

C IF THERE ARE NO PRODUCTS, LEAVE 
C 

IF (LCM) 100,100,30 
30 CONTINUE 

C 

C COMPUTE THE NEGATIVE LAGS 
C 

DO 40 I-l, LCM 

CALL MD0T3 ( N, M, L, XMI NOF ( LB-I B, LA ) , AA, BB( I BB ) ,Z FNBTR,CC ( ICC ) t 1 ) 
IB=IB-1 



40 



IBB=I BB-ML 
ICC=ICC+NL 



K AND LC FOR POSITIVE LAG COMPUTATION 



C ADJUST 
C 

LC=LC+K 
K=0 

50 CONTINUE 

C 

C SET UP MD0T3 CONTROL PARAMETERS 
C 

LCM IS MATRIX NO. OF PRODUCTS TO COMPUTE 
IA IS MATRIX INDEX -1 OF AA FOR NEXT PRODUCT 
IAA IS VECTOR INDEX OF AA FOR NEXT PRODUCT 
ICC IS VECTOR INDEX OF NEXT OUTPUT (ALREADY SET) 



LCM = XMINOF ( LA— K»LC-K ) 



IA 
IAA 



K 

I A*NM+1 



C LEAVE IF THERE ARE NO PRODUCTS 
C 

IF (LCM) 100,100,60 
60 CONTINUE 

C 

C COMPUTE THE POSITIVE LAGS 
C 

DO 70 1*1, LCM 

CALL MD0T3 ( N, M t L » XMINOF ( LA-I A, LB ) , AA( I AA ) , BB, ZFNBTR,CC( ICC), 1) 
IA=IA+l 
I AA=I AA+NM 
70 ICC=ICC+NL 

C 

C THAT'S ALL 
C 

100 CONTINUE 
RETURN 
END 



0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
0197 
0198 
0199 
0200 
0201 
0202 
0203 
0204 
0205 
0206 
0207 
0208 
0209 
0210 
0211 
0212 
0213 
0214 
0215 
0216 
0217 
0218 
0219 
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* CSOUT (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO* 0126 

* FAP 0001 
♦CSOUT 0002 

COUNT 150 0003 

LBL CSOUT 0004 

ENTRY CSOUT ( ITAPE, NSPACE, CI, C1NAME,C2, C2NAME, ..J ) 0005 

* 0006 

* 0007 

* ABSTRACT 0008 

* 0009 

* TITLE - CSOUT 0010 

* CONSTANTS OUTPUTTEO IN FIXED FORMAT 0011 

* 0012 

* CSOUT WRITES A LIST OF VARIABLES AND THEIR NAMES ON A 0013 

* LOGICAL TAPE ACCORDING TO A FIXED FORMAT WITH INITIAL 0014 
» SPACING (OR PAGE RESTORE ) • 0015 
» 0016 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN- I I COMPATIBLE) 0017 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME PLUS ONE TAPE UNIT) 0018 

* STORAGE - 49 REGISTERS 0019 

* SPEED - 0020 

* AUTHOR - R.A. WIGGINS, JULY, 1964 0021 

* 0022 

* 0023 

* USAGE 0024 

* 0025 

* TRANSFER VECTOR CONTAINS ROUTINES - CARIGE, HRADJ 0026 

* AND FORTRAN SYSTEM ROUTINES - (STH),<FIL) 0027 

* 0028 

* FORTRAN USAGE 0029 

* CALL CSOUT ( I TAPE , NSPACE,Ci ,C1NAME» C2,C2NAME, ... ,CN,CMNAME> 0030 
» 0031 

* 0032 

* INPUTS 0033 
» 0034 
» ITAPE IS LOGICAL TAPE NUMBER OF DESIRED OUTPUT TAPE. 0035 
» 0036 

* NSPACE IS DESIRED NUMBER (MAY BE ZERO) OF SPACES BEFORE ANY 0037 

* OUTPUT. IF NEGATIVE AN INITIAL PAGE RESTORE OCCURS. 0038 

* 0039 
» C1,C2,...,CN ARE THE FIXED OR FLOATING POINT VARIABLES TO BE 0040 

* PRINTED. 0041 

* 0042 

* C 1NAME , C2NAME » ♦ * • » CNNAME ARE THE HOLLERITH NAMES OF Cl,C2,...,CN 0043 

* RESPECTIVELY IN FORMAT ( A6 ) OR ( A5 ) OR ... (Ai). 0044 

* 0045 
» 0046 

* OUTPUTS 1. NSPACE SPACES OR A PAGE RESTORE OCCURS 0047 

* 2. THE VARIABLES AND THEIR NAMES ARE WRITTEN AS THEY 0048 

* WOULD BE BY THE FORTRAN STATEMENTS 0049 

* 0050 
» WRITE OUTPUT TAPE ITAPE, 10, C1NAMR,C1,C2NAMR,C2, 0051 

* I CNNAMR, CN 0052 
» 10 F0RMAT(5(2XA6,3H = G14.7)) 0053 

* 0054 

* WHERE CNNAMR * HR ADJF ( CNNAME ) . 0055 
» 0056 

* 0057 
» EXAMPLES 0058 

* 0059 

* 1. INPUTS - Cl = l. C1NAME J =3H0NE C2*2 C2NAME = 3HTW0 0060 

* ITAPE * 2 NSPACE = 2 0061 

* USAGE - CALL CSOUT ( ITAPE, NSPACE, CI, C 1NAME,C2,C2NAME ) 0062 
» OUTPUTS - THE FOLLOWING 3 LINES 0063 

* 0064 

* 0065 
» ONE = 1.0000000 TWO = 2 0066 

* WILL BE PRINTED OFF LINE FROM LOGICAL TAPE 2 (UNDER 0067 

* PROGRAM CONTROL). 0068 
» 0069 

* 2. EXAMPLE WITH LITERAL ARGUMENTS. THE LAST ARGUMENT IS IGNOREO SINCE 0070 
» IT HAS NO NAME. 0071 
» USAGE - CALL CSOUT( 2 , 1 , . 01 , 1HX , 5 ) 0072 

* OUTPUTS - THE FOLLOWING 2 LINES 0073 

* 0074 
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• 




X - 


0.1000000E-01 


0075 


* 




WILL BE PRINTED OFF LINE FROM LOGICAL TAPE 2 (UNDER 


0076 


* 




PROGRAM 


CONTROL) . 


0077 


-» 








0078 


• 








0079 


» PROGRAM FOLLOWS BELOW 




0080 


» 








0081 


XR4 


HTR 


0 


STORAGE REGISTER FOR IR 4 


0082 




BCI 


1, CSOUT 




0083 


CSOUT 


SXO 


XR4,4 


SAVE IR4 


0084 




CLA 


1»4 


AND 


0085 




STA 


ITAPE 


USE 


0086 




CLA 


2,4 


CAR IGE 


0087 




STA 


NSPACE 


TO 


0088 




TSX 


$CARIG£,4 


♦MAKE THE 


0089 


I TAPE 


TSX 


♦♦,o 


INITIAL 


0090 


NSPACE 


TSX 


♦ ♦,0 


SPACES. 


0091 




LXD 


XR4,4 


RESET IR 4 


0092 




CLA* 


It* 


AND 


0093 




TSX 


$(STH),4 


♦GO INITIALIZE 


0094 




PZE 


FORMAT, ,1 


( STH ) • (1 IN DECREMENT INDICATES THAT 


0095 




LXD 


XR4,4 


RESET IR 4 IS STORED IN THE REVERSE 


0096 




TRA 


LKAHD 


AND GO CHECK. OF THE NORMAL ORDER) 


0097 


LOOP 


CLA* 


2,4 


GET NEXT NAME 


0098 




SXD 


XR4,4 


AND 


0099 




TSX 


$HRADJ,4 


RIGHT ADJUST IT. 


0100 




LXD 


XR4,4 




0101 




XCA 




PUT IN MQ 


0102 




STR 




♦AND FEED IT TO ( IOH). 


0103 




LOO* 


1,4 


GET NEXT VARIABLE 


0104 




STR 




AND FEED IT TO ( IOH). 


0105 


LKAHD 


CAL 


3,4 


THEN CHECK IF 


0106 




ANA 


=0777777700000 NEXT ARGUMENT (VARIABLE) 


0107 




LAS 


TSX 


IS TSX ,0 


0108 




TRA 


*+2 


IT IS NOT 


0109 




TRA 


Al 


IT IS, GO CHECK NEXT ARGUMENT. 


0110 


EXIT 


SXD 


XR4,4 


IT IS NOT, PREPARE TO LEAVE 


0111 




TSX 


$(FIL) ,4 


♦GO ROUND-OUT (STH). 


0112 




LXD 


XR4,4 


AND 


0113 




TRA 


3,4 


♦RETURN 


0114 


Al 


CAL 


4,4 


CHECK NEXT ARGUMENT I NAME ) 


0115 




ANA 


=0777777700000 FOR 


0116 




LAS 


TSX 


TSX ,0 FORM. 


0117 




TRA 


♦+2 


IT IS NOT. 


0118 




TIX 


LOOP, 4, 2 


IT IS, BUMP IR4 AND GO WRITE 


0119 




TIX 


EXIT, 4, I 


IT IS NOT, BUMP IR4 AND PREPARE TO RETURN* 


0120 


* 








0121 


» CONSTANTS 






0122 


♦ 








0123 


TSX 


TSX 


0,0 




0124 


FORMAT 


BCI 


4, (5(2XA6, 


3H = G14.7)) 


0125 




END 






0126 
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CUFIT1 » ♦ CUFIT1 * 



* CUFIT1 (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO. 0325 

* FAP 0001 
•CUFIT1 0002 

COUNT 300 0003 

LBL CUFIT1 0004 

ENTRY CUFIT1 ( FOFX , XLO, DELX, COEFS ) 0005 

* 0006 
» 0007 
» ABSTRACT 0008 

* 0009 

* TITLE - CUFIT1 0010 

* FIND CUBIC WHICH EXACTLY FITS 4 EQUALLY SPACED POINTS 0011 

* 0012 
» CUFIT1 FINDS C0,C1,C2, AND C3 SUCH THAT THE CUBIC 0013 

* POLYNOMIAL 0014 
« 2 3 0015 

* F(X) = CO ♦ C1*X ♦ C2»X ♦ C3*X 0016 
» 0017 

* TAKES ON SPECIFIED VALUES AT 4 EQUALLY SPACED VALUES 0018 

* OF X, NAMELY AT XLO, XLO+DELX, XL0+2*DELX AND XL0+3»DELX, 0019 

* WHERE XLO AND DELX ARE PARAMETERS, 0020 

* 0021 

* CUFIT1 HAS TWO AUTOMATIC HI SPEED BYPASSESt ONE EFFECTIVE 0022 

* IN CASES WHERE XL0=-3 AND DELX^+2, THE OTHER APPLYING 0023 

* TO REPEATED CALLS OF CUFIT1 WITH IDENTICAL VALUES OF XLO 0024 

* AND DELX. 0025 

* 0026 

* LANGUAGE - FAP SUBROUTINE (FORTRAN-II COMPATIBLE) 0027 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0028 
» STORAGE - 158 REGISTERS 0029 
» SPEED - ON 709 , ON 7090 0030 
» 1. GENERAL. 614MC=7. 37MS, 545MC«1.19MS 0031 
» 2. REPEAT CALL IN GENERAL 0032 

* WITH SAME XLO, DELX. 496MC=5.95MS, 445MC=.970MS 0033 
» 3. CASE IN WHICH XLO * -3 0034 
» AND DELX = 2 . 290MC=3.48MS, 268MC».584MS 0035 

* 0036 

* WHERE MC = MACHINE CYCLES, MS * MILLISECONDS. 0037 

* 0038 

* AUTHOR - S.M. SIMPSON, MARCH 1964 0039 

* 0040 
» 0041 

* USAGE 0042 

» 0043 

» TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0044 

* AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0045 

* 0046 

* FORTRAN USAGE 0047 

* CALL CUFIT1 (FOFX, XLO, DELX, COEFS) 0048 

* 0049 

* 0050 

* INPUTS 0051 

* 0052 
» FOFX(I) 1=1.. .4 CONTAINS THE VALUES THAT THE POLYNOMIAL 0053 

* MUST ASSUME, AS DETAILED BELOW 0054 

* 0055 
» XLO IS DEFINED IN THE ABSTRACT 0056 

* 0057 

* DELX IS DEFINED IN THE ABSTRACT. DELX SHOULD NOT BE ZERO 0058 

* BUT MAY BE NEGATIVE. 0059 
» 0060 

* 0061 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUTS IF £>ELX=0. 0062 

* #' 0063 

* COEFS(I) 1=1.. .4 WILL CONTAIN C0,C1,C2,C3 DETERMINED SO THAT 0064 

* THE POLYNOMIAL F(X) GIVEN IN THE ABSTRACT WILL SATISFY 0065 

* F(XLO) = FOFX(l) 0066 

* F(XL0+DELX) « F0FX(2) 0067 

* F(XL0+2*DELX) * F0FX(3) 0068 

* F(XL0+3*DELX) « F0FX(4) 0069 
» 0070 

* 0071 

* EXAMPLES 0072 
» 0073 

* 1. INPUTS - F0FXIU..4) = 2. ,4. , 10. ,26. XLO—1. DELX=1.0 0074 



PROGRAM LISTINGS 



* CUFIT1 
(PAGE 2) 



#••#••*»•*»•*»»»••*•**»» 

» CUFIT1 « 



< PAGE 2) 



* 


USAGE 


... 


CALL CUFITl(FOFX,XLO,DELX 


,C0EFS1) 




0075 


* 






CALL CUFITK FOFX ,XLO,DELX 


,C0EFS2) 




0076 


» 


OUTPUTS 




C0EFSH1...4) = C0EFS2( I. ♦ .4) * 


4.0, 


3.0 


,2.0, 1.0 


0077 


* 














0078 


* 


2. INPUTS 




F0FXI1...4) » -14. ,2., 10. ,58. 


XLO=- 


3. 


DELX*2.0 


0079 


» 






C0EFS4U...4) = -99. ,-99. ,-99., 


-99. 






0080 


• 


USAGE 




CALL CUFIT1(F0FX,XL0,DELX 


,C0EFS3) 




0081 


* 






CALL CUFIT1(FOFX,XLO,0.0, 


C0EFS4) 




0082 


• 


OUTPUTS 




C0EFS3(1...4) = 4.0,3.0,2.0,1.0 








0083 


• 






C0EFS4U...4) ^ -99. ,-99. ,-99., 


-99. 






0084 


• 














0085 


• 


3. INPUTS 




F0FXU...4) » 2.0,3.0,4.0,5.0 


XL0=*2.0 


DELX*1.0 


0086 


• 


USAGE 




CALL CUFIT1(F0FX,XL0,DELX 


,C0EFS5) 




0087 


* 


OUTPUTS 




C0EFS5I1...4) a 0.0,1.0,0.0,0.0 








0088 


• 














0089 


* 














0090 


• 


PROGRAM FOLLOWS BELOW 








0091 


• 














0092 




HTR 




0 XRl 








0093 




HTR 




0 XR4 








0094 




BCI 




1 , C UF I T 1 








0095 


* 














0096 


• 


ONLY ENTRY. 


CUF I T 1 ( FOFX , XLO , DELX , COEFS ) 








0097 


* 














0098 


CUFIT1 SXD 




CUFITl-2,4 








0099 




SXD 




CUFITl-3,1 








0100 


* 














0101 


* 


EXIT ON ZERO 


DELX 








0102 


• 














0103 




NZT* 




3,4 DELX 








0104 




TRA 




LEAVE 








0105 


* 














0106 


• 


BRING IN FM3 


,FM1,F1,F3 AND SET ADDRESSES 








0107 


* 














0108 




CLA 




1,4 A(FOFXll)) 








0109 




ADD 




Kl 








0110 




STA 




CLAF 








0111 




A XT 




4,1 








0112 


CLAF CLA 




**,1 ♦*»A(F0FX(1)}+1 








0113 




STO 




FM3+l,l 








0114 




TIX 




CLAF, 1,1 








0115 




CLA 




4,4 A(C0EFS(1)) 








0116 




STA 




STOCZ 








0117 




SUB 




Kl 








0118 




STA 




ST0C1 








0119 




SUB 




Kl 








0120 




STA 




ST0C2 








0121 




SUB 




Kl 








0122 




STA 




ST0C3 








0123 


• 














0124 


• 


(SO FAR IT 


HAS TAKEN ABOUT 29 HI SPEEDS) 








0125 


* 














0126 


• 














0127 


» 


SET TRIAL VALUES OF CO, CI, C2, C3 (FOR XLO= 


-3.0, 


DELX=2.0) 


0128 


* 


(C3) 




1 (-1 +3 -3 +1) ( FM3 ) 








0129 


• 


(C2> = 




(+ 3 -3 -3 +3 ) (FM1) 








0130 


• 


(CI) 


48 (+1 -27 +27 -1) (Fl) 








0131 


• 


(CO) 




(-3 +27 +27 -3) (F3) 








0132 


* 














0133 


• 


FIRST C3 












0134 


• 














0135 




CLA 




FM1 








0136 




FSB 




Fl 








01 37 




XCA 












0138 




FMP 




K3L 








0139 




FSB 




FM3 








0140 




FAD 




F3 








0141 




XCA 












0142 




FMP 




R48 








0143 


ST0C3 STO 




«* »#=A(C0EFS)-3 








0144 




STO 




C3 








0145 


» 














0146 


• 


THEN C2 












0147 


• 














0148 




CLA 




FM3 








0149 
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• THEN Ci 



* THEN CO 



FSB 


FM1 




0150 


FSB 


Fl 




0151 


FAO 


F3 




0152 


XCA 






0153 


FMP 


R16 




0154 


STO 


»» 


**=A(COEFS)-2 


0155 


STO 


C2 




0156 
0157 


Ci 






0158 
0159 


CLA 


Fl 




0160 


FSB 


FM1 




0161 


XCA 






0162 


FMP 


K27L 




0163 


FAD 


FM3 




0164 


FSB 


F3 




0165 


XCA 






0166 


FMP 


R48 




0167 


STO 


** 


**=A(CO£FS)-l 


0168 


STO 


CI 




0169 
0170 


CO 






0171 
0172 


CLA 


FM1 




0173 


FAD 


Fl 




0174 


XCA 






0175 


FMP 


K9L 




0176 


FSB 


FM3 




0177 


FSB 


F3 




0178 


XCA 






0179 


FMP 


R16 




0180 


STO 


*• 


**=A(COEFS) 


0181 


STO 


CI 




0182 



* 0183 

* (SETTING THE ABOVE TAKES 19 HI SPEEDS, 12 FADS, 7 FMPS) 0184 

* 0185 

* NOW WE ARE ALL DONE IN THE CASE THAT 0186 



• XLO = 


-3.0 AND DELX = 2.0 




0187 


* 








0188 


CLS* 


2,4 


-XLO 




0189 


CAS 


K3L 






0190 


TRA 


CKJUMP 


NO 




0191 


TRA 


*+2 


MAYBE 




0192 


TRA 


CKJUMP 


NO 




0193 


CLA* 


3,4 


DELX 




0194 


CAS 


K2L 






0195 


TRA 


CKJUMP 


NO 




0196 


TRA 


LEAVE 


EXIT 




0197 


• 








0198 


* UF XL0=-3 


AND DELX*2 


, THE CHECK 


TAKES 7 HI SPEEDS, OTHERWISE 


0199 


* AVERAGE 


= 3) 






0200 


* 








0201 


* OTHERWISE 


JUMP AHEAD 


IN THE CASE 


THAT 


0202 


* XLO AND 


DELX ARE BOTH THE SAME 


AS LAST CALL. 


0203 


* 








0204 


CKJUMP CLA* 


3,4 


DELX 


IN AC 


0205 


LDQ* 


2,4 


XLO IN MQ 


0206 


CAS 


LASDEL 




FIRST CHECK DELX 


0207 


TRA 


NEW 


NEW 




0208 


TRA 


*+2 


MAYBE 


OLD 


0209 


TRA 


NEW 


NEW 




0210 


XCA 




CHECK 


XLO IF MAYBE 


0211 


CAS 


LASXLO 






0212 


TRA 


*+2 


NEW 




0213 


TRA 


REVISE 


JUMP 


AHEAD 


0214 


XCA 




NEW, 


RESTORE AC, MQ 


0215 


» 








0216 


* STORE THE 


NEW XLO AND 


DELX 




0217 


• 








0218 


NEW STO 


LASDEL 






0219 


STO 


LASXLO 






0220 


• 








0221 


* (TAKES 8 HI SPEEDS IF 


JUMP, 7 IF 


NOT) 


0222 



* 0223 

* IN THE GENERAL CASE WE HAVE TO SET THE CONSTANTS 0224 



CUFIT1 



PROGRAM LISTINGS 



*•»#*••*•»**•»******••*» 

* CUFIT1 » 
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» KSQUAR 


, KCUBE t Gt 2G, 


3G, 3GSQR 


022 5 


* 


WHERE K « 2/DELX 




VJC.CO 






G = -K*(XL0+3/K) * -K*XL0-3 


yJCc. i 










\)c.c.O 




CLA 


K2L 




yJCc. V 




crvD 
rur 


L ASDEL 








C TO 


K 








C MD 


K 




0232 




Oil) 






0233 




vr » 
Al» A 






02 34 




CUD 

r nr 


K 




0235 




5 1 U 


If fl IRC 




Uc JO 




CLS 


|^ 




02 37 




XCA 






0238 




FMP 


LASXLO 




0239 




FSB 


K3L 




0240 




STO 


G 




0241 




FAD 


G 




0242 




STO 


TWG 




0243 




FAD 


G 




0244 




STO 


THG 




0245 




XCA 






0246 




FMP 


G 




0247 




STO 


THGSQR 




0248 


• 








0249 


» (THESE SETTI 


NGS TAKE 12 HI 


SPEEDS * 1 FDP, 4 FMPS, 3 FADS) 


0250 


• 








025 1 


• COMPUTE AND 


STORE THE REVISED COEFFICIENTS AS FOLLOWS 


0252 


• 


(C3> 


(K**3 


0 0 0) (C3) 


0253 


• 


(C2> 


(3(K**2)G 


K**2 0 0) (C2) 


0254 


* 


(CI) 


= (3K(G**2) 


2KG K 0) (CI) 


0255 


* 


(CO) 


(G**3 


G»*2 G 1) (CO) 


02 56 


* 








0257 


REVISE 


LDQ 


C3 




fi?*i ft 




FMP 


KCUBE 




0259 




STO* 


STOC3 




0260 




LDQ 


C3 


C2=(K**2)*( ( 3G)*C3+C2) 


0261 




FMP 


THG 




0262 




FAD 


C2 




0263 




XCA 










FMP 


KSQUAR 




0265 




STO* 


STOC2 




0266 




LDQ 


C3 


C1=K*( ( 3G**2)*C3+2G*C2+C1) 


026 7 




FMP 


THGSQR 




0268 




STO 


TEMP 




0269 




LDQ 


C2 




0270 




FMP 


TWG 




027 1 




FAD 


TEMP 




0272 




FAD 


CI 




0273 




XCA 






0274 




FMP 


K 




0275 




STO* 


ST0C1 




0276 




LDQ 


C3 


CZ=CZ+G(C1+G(C2+G*C3) ) 


0277 




FMP 


G 




0278 




FAD 


C2 




0279 




XCA 






0280 




FMP 


G 




028 1 




FAD 


CI 




0282 




XCA 






0283 




FMP 


G 




0284 




FAD 


CZ 




0285 




STO* 


STOCZ 




0286 


• 








028 7 


« (REVISEON TAKES 16 HI SPEEDS, 9 FMPS, 6FADS) 


0288 


* 








0289 


* EXIT 








0290 


* 








0291 


LEAVE 


LXD 


CUFIT1-3, 1 




0292 




TRA 


5,4 




0293 


# 








0294 


* CONSTANTS 






0295 


* 








0296 


Kl 


PZE 


1 




0297 


K2L 


DEC 


2.0 




0298 


K3L 


DEC 


3.0 




0299 
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K9t DEC 9,0 0300 

K27L DEC 27.0 0301 

R16 DEC .0625 =1/16 0302 

R48 DEC .020833333 =1/48 0303 

• 0304 

» VARIABLES 0305 

» 0306 

F3 PZE •»,#»,** NOTE - 0307 

Fl PZE **,#*,*# ORDER 0308 

FM1 PZE **,»#,** OF F SEQUENCE 0309 

FM3 PZE **,«*,♦* IS IMPORTANT 0310 

LASXLO PZE »*,#*,*# 0311 

LASOEL PZE *»,**,## 0312 

KCUBE PZE #«,»»,** K*»3 0313 

KSQUAR PZE #*,#«,** K«*2 0314 

K PZE #*,»*,** 2/DELX 0315 

THGSQR PZE *»,**,*# 3«<G»*2> 0316 

THG PZE #* f *» f »* 3*G 0317 

TWG PZE *»,»#,*« 2*G 0318 

G PZE *»,*»,*» 0319 

CZ PZE **,»*,♦» 0320 

CI PZE »»,**,»* 0321 

C2 PZE **,»♦,** 0322 

C3 PZE »*,*»,«* 0323 

TEMP PZE •»,*«,»* 0324 

END 0325 



•«••*••»••••«••»•**• PROGRAM LISTINGS ##***»#»#*»»*»#»***»#•## 

CVSOUT * • CVSOUT » 
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* CVSOUT { SUBROUTINE ) 9/29/64 LAST CARD IN DECK IS NO. 0220 
» FAP 0001 
•CVSOUT 0002 

COUNT 200 0003 

LBL CVSOUT 0004 

ENTRY CVSOUT { I TAPE, NSPACE, FMTHED, FMTL IN* ILO, IHI , ARGLO, ARGDEL , 0005 

» SPACE, X 1,X2,...,XN) 0006 

» 0007 

* ABSTRACT 0008 

* 0009 

* TITLE - CVSOUT 0010 

* OUTPUT COLUMN VECTORS BY NORMAL OR LITERAL FORMATS 0011 

* 0012 

* CVSOUT IS A VARIABLE-LENGTH-CALLING-SEQUENCE PROGRAM 0013 

* WHICH OUTPUTS AN ARBITRARY NO. OF VECTORS IN COLUMN 0014 

* FASHION ONTO A SPECIFIED TAPE UNIT. IT PROVIDES A 0015 
» LEFTMOST COLUMN WITH VALUES INCREMENTED BY A SPECIFIED 0016 

* AMOUNT FROM A SPECIFIED BASE. USER SUPPLIES HEADING 0017 

* FORMAT AND LINE FORMAT AS EITHER NORMAL FORMAT VECTORS 0018 

* OR LITERAL ONES. 0019 
« 0020 
» LANGUAGE - FAP SUBROUTINE ( FORTRAN— 1 1 COMPATIBLE) 0021 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME PLUS ONE TAPE UNIT) 0022 

* STORAGE - 84 REGISTERS 0023 

* SPEED - 0024 

* AUTHOR - S.M. SIMPSON JR, SEPTEMBER 1963 0025 

* 0026 

* USAGE 0027 

* 0028 

* TRANSFER VECTOR CONTAINS ROUTINES - CAR IGE, FMTOUT, VECOUT 0029 

* AND FORTRAN SYSTEM ROUTINES - NONE 0030 

* 0031 
» FORTRAN USAGE 0032 

* CALL CVSOUT ( I TAPE, NSPACE , FMTHED, FMTL I N, I LO, IHI , ARGLO, ARGDEL, 0033 

* 1 SPACE,X1,X2,...,XN) 0034 

* 0035 

* INPUTS DEFINE A NORMLIT FORMAT VECTOR AS EITHER 0036 

* A) A NORMAL FORMAT VECTOR, 0037 

* OR B) LITERAL HOLLERITH IN A CALLING SEQUENCE WHOSE 0038 

* CHARACTERS (READING CONTINUOUSLY FROM LEFT TO RIGHT) 0039 

* ARE THE DESIRED FORMAT STRIPPED OF THE ENCLOSING 0040 

* PARENTHESES. THE FIRST AND SECOND CHARACTERS MUST 0041 
» NOT BE QUOTE ( UNQUOTE OR QUOTE ) UNQUOTE 0042 

* RESPECTIVELY. (TWO BLANKS FOLLOWED BY I WOULD BE OK.) 0043 

* 0044 

* I TAPE IS DESIRED LOGICAL TAPE NUMBER 0045 

* 0046 

* NSPACE IS DESIRED NO. OF INITIAL SPACES (MAY BE ZERO) BEFORE 0047 

* ANY PRINTING. 0048 

* IF NEGATIVE A PAGE RESTORE OCCURS BEFORE PRINTING. 0049 

* 0050 

* FMTHED ( I ) 1=1,2,... OR 1=1,0,-1,... IS A NORMLIT FORMAT VECTOR TO 0051 

* BE PRINTED AS A HEADING FOR THE COLUMNS. 0052 

* 0053 

* FMTLIN(I) 1=1,2,... OR 1=1,0,-1,... IS A NORMLIT FORMAT VECTOR 0054 

* GIVING THE PRINTING FORMAT FOR A SINGLE LINE OF 0055 

* OUTPUT. THE LIST OF QUANTITIES PRINTED ON A LINE IS 0056 

* ARG(L),X1(I),X2(I),...,XN(I) WHERE ARG(L) IS DEFINED 0057 

* BELOW. FMTLIN MUST INCLUDE THE CFLTG) FORMAT FOR 0058 

* ARG(L) AS WELL AS FOR THE X VECTORS. 0059 

* 0060 

* ILO IS FIRST SUBSCRIPT OF VECTOR RANGE TO BE PRINTED. 0061 

* MUST EXCEED 0 (NOT CHECKED). 0062 
« 0063 

* IHI IS LAST SUBSCRIPT OF VECTOR RANGE TO BE PRINTED. 0064 

* MUST BE GRTHN= ILO (NOT CHECKED). 0065 

* 0066 

* ARGLO INITIAL VALUE OF QUANTITY ARG(L) TO APPEAR IN LEFTMOST 0067 

* COLUMN. 0068 
» MUST BE FLOATING POINT. 0069 
» 0070 

* ARGDEL INCREMENT FOR ARG, FLOATING POINT. 0071 

* ARG ( L) = ARGLO ■*•( L—l )* ARGDEL WHERE L = LINE INDEX. 0072 

* 0073 



*•****••»«•**•»••»•*#»»« PROGRAM LISTINGS »**#*»»#*♦*»#***»»*#♦*♦* 
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* 




SPACE (I ) 


1=1. ..N+i IS 


SCRATCH AREA WHERE N « NO. 


OF VECTORS. 


0074 


* 












0075 


• 




XIII) 


I=lLO...IHI 


IS FIRST VECTOR, ANY MODE 




0076 


• 




X2U) 


I=lLO...IHI 


IS SECOND VECTOR, ANY MODE 




0077 


# 




ETC 








0078 


• 




XNU ) 


I=ILG...IHI 


IS N-TH VECTOR, ANY MODE* 


N MUST EXCEED 


0079 


* 






ZERO. 






0080 


* 












0081 


* 


OUTPUTS 


THE VECTORS 


ARE PRINTED COLUMNWISE AS ILLUSTRATED BELOW. 


0082 


* 












0083 


* 












0084 


• 


EXAMPLES 








0085 


* 












0086 


* 


1. 


USING NORMAL FORMATS 






0087 


* 




INPUTS - 


XU...10) * 


1.1,2.2,..., 10.10 1X1(1... 


101 * 1,2, ...,10 


0088 


* 






IX2( 1...10) 


= 2, 3, ...,11 1X3(1. ..10) = 


3, 4, ...,12 


0089 


• 






FMTH( 1...6) 


= 34H(26H ARGX X 1X1 


1X2 1X3,//) 


0090 


» 






FMTLU...3) 


« 18H(F6.2,F6.1,2X t 3I4) 




0091 


♦ 




USAGE 


DIMENSION SPACE(5) 




0092 


* 






CALL CVSOUT (2, 3, FMTH, FMTL, 4, 10, -.03, . 01» SPACE* X, 


0093 


> 






1 1X1 


,1X2,1X3) 




0094 


* 




OUTPUTS - 


THE FOLLOWING 12 LINES 




0095 


• 












0096 


* 












0097 


* 












0098 


* 






ARGX X 


1X1 1X2 1X3 




0099 


* 












0100 


* 






-0.03 4.4 


4 5 6 




0101 


» 






-0.02 5.5 


5 6 7 




0102 


» 






-0.01 6.6 


6 7 8 




0103 


* 






0.00 7.7 


7 8 9 




0104 


* 






0.01 8.8 


8 9 10 




0105 


• 






0.02 9.9 


9 10 11 




0106 


* 






0.03 10.1 


10 11 12 




0107 


* 






WILL BE PRINTED OFF-LINE FROM LOGICAL 2 


(UNDER PROGRAM 


0108 


* 










CONTROL) 


0109 


* 












0110 


* 


2. 


USING LITERAL FORMATS 






Oil! 


* 




INPUTS - 


X, 1X1,1X2, 1X3 SAME AS IN EXAMPLE 1. 




0112 


* 




USAGE 


CALL CVS0UT(2,3,32H26H ARGX X 


1X1 1X2 1X3, 


0113 


» 






1 //,16HF6.2,F6.1,2X,3I4,4, 10,-. 03, 


.01, SPACE, X» 


0114 


* 






2 1X1,1X2,1X3) 




0115 


* 




OUTPUTS - 


IDENTICAL TO 


THOSE OF EXAMPLE 1. 




0116 


• 












0117 


* 


PROGRAM FOLLOWS BELOW 






0118 


* 












0119 


* 












0120 


* 


TRANSFER VECTOR CONTAINS 


CARIGE, FMTOUT, VECOUT 




0121 



HTR 


0 




XR1 


0122 


HTR 


0 




XR2 


0123 


HTR 


0 




XR4 


0124 


BCI 


ItCVSOUT 






0125 


* ONLY ENTRY. 


CVSOUT ( I TAPE 


, NSPACE, FMTHED, FMTL IN, ILO, IHI , ARGLO,ARGDEL, 


0126 


* 


SPACE, XI, 


X2, 


...,XN) 


0127 


CVSOUT SXD 


CVSOUT-2, 


4 




0128 


SXD 


CVSOUT-3, 


2 




0129 


SXD 


CVSOUT-4, 


1 




0130 


Kl CLA 


1,4 




A( ITAPE) 


0131 


STA 


CI 






0132 


STA 


Fl 






0133 


STA 


VI 






0134 


CLA 


2,4 




A(NSPACE) 


0135 


STA 


C2 






0136 


CLA 


3,4 




A (FMTHED) 


0137 


STA 


F2 






0138 


CLA 


4,4 




A ( FMTL IN ) 


0139 


STA 


V2 






0140 


CLA 


9,4 




A(SPACE) 


0141 


STA 


V3 






0142 


STA 


STO 






0143 


* SET UP LOOP 


CONTROLS 






0144 


CLA* 


6,4 




IHI 


0145 


STD 


TXL2 




TO LOOP CONTROL. 


0146 


CLA* 


7,4 




ARGLO 


0147 


STO* 


9,4 




TO SPACE(l). 


0148 
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CLA» 


5,4 


ILO 


0149 




PDX 


0,2 


TO XR2. 


0150 




CLA 


8,4 


A(ARGDEL) 


0151 




STA 


FAD 




0152 


» OPERATE THE CARRIAGE 




0153 




TSX 


$CARIGE,4 




0154 


CI 


TSX 


♦*,0 


**=A( ITAPE) 


0155 


C2 


TSX 


»* ,0 


♦♦=A(NSPACE) 


0156 


• AND 


PRINT 


THE HEADING 




0157 




TSX 


$FMT0UT,4 




0158 


Fl 


TSX 


**,0 


♦ ♦=A( ITAPE) 


0159 


F2 


TSX 


»* ,0 


♦♦=A( FMTHED ) 


0160 


» THEN 


COUNT 


THE VECTORS 




0161 




LXO 


CVSOUT-2, 4 




0162 




AXT 


0,1 




0163 




TXI 


♦♦1,4,-9 




0164 




SXA 


NXTLIN, 4 


(SAVE FOR INITIALIZING LOOP) 


0165 


CAL 


CAL 


1,4 


TSX XI, 0 TSX X2,0..« 


0166 




ANA 


AMASK 




0167 




LAS 


TSXZ 




0168 




TRA 


*+2 


DONE 


0169 




TRA 


♦+2 


MORE 


0170 




TRA 


COVER 


DONE 


0171 




TXI 


•+1,1,1 




0172 




TXI 


CAL, 4,-1 




0173 


* FINI 


SHED 






0174 


COVER 


SXD 


TXL1,1 


STORE N, 


0175 




TXI 


•♦1,1.1 




0176 




SXD 


NP1,1 


AND N+l. 


0177 




SXA 


LEAVE, 4 


(SAVE FOR EXITING TO 1,4) 


0178 


• SET 


NEXT LINE OF OUTPUT IN 


SPACE( 1...N+1) 


0179 


* 








0180 


* XR4 ACQUIRES VECTOR ADDRESSES 


0181 


* XR2 ACQUIRES VECTOR ELEMENTS ( ILO TO IHI) 


0182 


* XR1 STORES IN SPACE VECTOR (2...N+1) 


0183 


NXTLIN 


AXT 


•♦,4 


(1,4 IS THEN TSX XI, 0) 


0184 




AXT 


1,1 




0185 


* START LOOP 






0186 


CLA 


CLA 


lt4 




0187 




ADD 


Ki 


TSX XK+1,0 


0188 




STA 


• ♦1 




0189 




CLA 


• ♦,2 


♦♦=A(XK)+1 


0190 


STO 


STO 


• •,1 


♦♦^A(SPACE) 


0191 




TXI 


•♦1,4,-1 




0192 




TXI 


♦♦1,1,1 




0193 


TXL1 


TXL 


CLA,l f •• 


♦ *=N 


0194 


♦ GO OUTPUT 


ONE LINE 




0195 




TSX 


$VEC0UT,4 




0196 


VI 


TSX 


** ,0 


♦♦=A( ITAPE) 


0197 


V2 


TSX 


••,0 


»#=A( FMTL IN ) 


0198 


V3 


TSX 


«♦ ,0 


♦*=A(SPACE) 


0199 




TSX 


KD1,0 


1 


0200 




TSX 


NP1,0 


TO N + l 


0201 


» CHEC 


K FOR 


MORE AFTER INCREMENTING SPACECl) 


0202 




CLA» 


V3 




0203 


FAD 


FAD 


** 


••-A(ARGDEL) 


0204 




TNZ 


• ♦2 




0205 




SSP 






0206 




STO* 


V3 




0207 




TXI 


♦♦1,2,1 




0208 


TXL2 


TXL 


NXTLIN, 2, ♦♦ 


•♦=IHI 


0209 


* EXIT 








0210 


LEAVE 


AXT 


♦♦,4 




0211 




LXD 


CVSOUT-3,2 




0212 




LXD 


CVSOUT-4,1 




0213 




TRA 


lt4 




0214 


* CONSTANTS, 


TEMPORARIES 




0215 


KD1 


PZE 


0,0,1 




0216 


AMASK 


OCT 


777777700000 




0217 


TSXZ 


TSX 


0,0 




0218 


NP1 


PZE 


0,0, ♦* 


♦♦*N0. OF VECTORS + 1 


0219 




END 






0220 
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* DADECK (SUBROUTINE) 9/4/64 LAST CARO IN DECK IS NO. 0069 

* LABEL 0001 
CDAOECK 0002 

SUBROUTINE DADECK ( ITPIN, ITPOUT ) 0003 

C 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - DADECK 0008 

C LIST DATA DECK AND REPOSITION TAPE TO FRONT OF DECK 0009 

C 0010 
C DADECK LISTS THE DATA ON TAPE ITPIN FROM THE PLACE WHERE 0011 

C THE TAPE IS POSITIONED WHEN DADECK IS CALLED TO THE END 0012 
C OF FILE. THE TAPE IS REPOSITIONED BEFORE RETURN IS MADE* 0013 

C ALL 80 COLUMNS OF A CARD WILL BE LISTED. THE OUTPUT 0014 
C FORMAT SPACES ONE COLUMN TO THE RIGHT SO THAT CHARACTERS 0015 
C IN COLUMN ONE WILL NOT AFFECT THE CARRIAGE CONTROL. THE 0016 

C LISTING IS MADE ON ITPOUT. 0017 

C 0018 

C DADECK MAKES NO COMMENTS AND DOES NOT RESTORE THE 0019 

C CARRIAGE. IF THERE IS NO DATA ON ITPIN, THERE WILL BE NO 0020 

C OUTPUT AT ALL FROM DADECK, 0021 

C 0022 

C LANGUAGE - FORTRAN II 0023 

C EQUIPMENT - 709/7090/7094 (MAIN FRAME AND TAPE DRIVES) 0024 

C STORAGE - 100 REGISTERS 0025 

C SPEED - PROPORTIONAL TO NO. OF DATA CARDS 0026 

C AUTHOR - J. N. GALBRAI TH, JR. AND R. A. WIGGINS 0027 

C 0028 

C 0029 

C USAGE 0030 

C 0031 

C TRANSFER VECTOR CONTAINS ROUTINES - EOFSET,RSKIP 0032 

C AND FORTRAN SYSTEM ROUTINES - C TSH) , ( RTN ) , C STHJ , ( FIL ) 0033 

C 0034 

C FORTRAN USAGE 0035 

C CALL DADECM ITPIN, ITPOUT) 0036 

C 0037 

C 0038 

C INPUTS 0039 

C 0040 

C ITPIN FORTRAN II INTEGER. LOGICAL TAPE NUMBER OF INPUT TAPE 0041 

C (TAPE CONTAINING DATA DECK). 0042 

C 0043 

C ITPOUT FORTRAN II INTEGER. LOGICAL TAPE NUMBER OF OUTPUT TAPE 0044 

C (TAPE ON WHICH DATA DECK WILL BE WRITTEN). 0045 

C 0046 

C 0047 

C OUTPUTS 0048 

C 0049 

C PRINTED AS DESCRIBED ABOVE. 0050 

C 0051 

C 0052 

C PROGRAM FOLLOWS BELOW 0053 

C 0054 

DIMENSION DATA ( 14 ) 0055 

INUM=0 0056 

CALL E OF SET (0, EOF, I TAPE ) 0057 

IF (EOF) 40,10,40 0058 

10 CONTINUE 0059 

READ INPUT TAPE ITPIN»20, < DATA( I ) , 1*1, 14) 0060 

20 F0RMAT(13A6,A2) 0061 

WRITE OUTPUT TAPE ITPOUT, 30, ( DATA( I ) , 1=1, 14) 0062 

30 F0RMAT(1X13A6,A2) 0063 

INUM=INUM+1 0064 

GO TO 10 0065 

40 CALL RSKIP(ITPIN,-INUM-1,E0F) 0066 

CALL EOFSET (-1 ,EOF, ITAPE ) 0067 

RETURN 0068 

END 0069 



••*•••«»•»«*••••»*•»**»* PROGRAM LISTINGS •***#**#»»#*»**#*«»**»»» 

* DELTA * » DELTA » 



* DELTA (FUNCTIONS) 9/4/64 LAST CARD IN DECK IS NO* 0140 

* FAP 0001 
•DELTA 0002 

COUNT 75 0003 

LBL DELTA 0004 

ENTRY DELTA F(ARG) 0005 

ENTRY XDELTA F(ARG) 0006 

ENTRY STEPR F(ARG) 0007 

ENTRY XSTEPR F(ARG) 0008 

ENTRY STEPL F(ARG) 0009 

ENTRY XSTEPL F(ARG) 0010 

ENTRY STEPC F(ARG) 0011 

ENTRY XSTEPC F(ARG) 0012 

* 0013 
» 0014 

* ABSTRACT 0015 

» 0016 

* TITLE - DELTA, WITH SECONDARY ENTRIES XDELTA, STEPR, XSTEPR, STEPL, 0017 

* XSTEPL, STEPC, XSTEPC 0018 

* DELTA FUNCTION AND STEP FUNCTIONS, FLOATING AND FIXED POINT 0019 
» 0020 

* DELTA HAS VALUE EQUAL TO PLUS ZERO UNLESS THE MAGNITUDE 0021 

* OF ITS ARGUMENT (WHICH MAY BE EITHER FIXED OR FLOATING 0022 

* POINT) IS ZERO, IN WHICH CASE DELTA HAS VALUE EQUAL TO 0023 

* 1.0 (FLOATING). 0024 

* 0025 

* XDELTA IS IDENTICAL TO DELTA EXCEPT THAT IT GIVES A 0026 

* FIXED POINT OUTPUT. 0027 

* 0028 

* STEPR HAS VALUE EQUAL TO PLUS ZERO UNLESS THE VALUE OF 0029 

* ITS ARGUMENT (EITHER FIXED OR FLOATING POINT) EXCEEDS 0030 

* ZERO, IN WHICH CASE STEPR HAS VALUE EQUAL 1.0 (FLOATING). 0031 

* 0032 

* XSTEPR IS IDENTICAL TO STEPR EXCEPT THAT IT GIVES A 0033 

* FIXED POINT OUTPUT. 0034 

* 0035 

* STEPL HAS VALUE EQUAL TO PLUS 1.0 UNLESS THE VALUE OF 0036 
» ITS ARGUMENT (EITHER FIXED OR FLOAITNG POINT) IS LESS 0037 

* THAN ZERO, IN WHICH CASE STEPL HAS VALUE EQUAL 0.0 (FLTG) 0038 

* 0039 
» XSTEPL IS IDENTICAL TO STEPL EXCEPT THAT IT GIVES A 0040 

* FIXED POINT OUTPUT. 0041 

* 0042 

* STEPC HAS VALUE EQUAL TO ZERO WHENEVER THE SIGN BIT OF 0043 
» ITS ARGUMENT IS NEGATIVE. OTHERWISE STEPC HAS VALUE * 0044 

* 1.0 (FLTG). 0045 

* 0046 

* XSTEPC IS IDENTICAL TO STEPC EXCEPT THAT IT GIVES A 0047 

* FIXED POINT OUTPUT. 0048 

* 0049 
» LANGUAGE - FAP FUNCTIONS (FORTRAN II COMPATIBLE) 0050 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0051 

* STORAGE - 17 REGISTERS 0052 

* SPEED - 6, 8, OR 10 MACHINE CYCLES 0053 
» AUTHOR - S.M. SIMPSON, APRIL 1964 0054 

* 0055 

* 0056 

* USAGE- 0057 

* 0058 

* TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0059 
» AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0060 

* 0061 

* FORTRAN USAGES 0062 
» Y = DELTAF ( X ) OR DELTAF( IX) 0063 

* Y = STEPRF(X) OR STEPRF(IX) 0064 

* Y = STEPLF(X) OR STEPLF(IX) 0065 
» Y= STEPCF(X) OR STEPCF(IX) 0066 
» I Y^XDELTAF ( X ) OR XDELTAF(IX) 0067 

* IY^XSTEPRF(X) OR XSTEPRF(IX) 0068 

* I Y=XSTEPLF ( X) OR XSTEPLF(IX) 0069 

* IY=XSTEPCF(X) OR XSTEPCF(IX) 0070 

* 0071 
» 0072 

* INPUTS 0073 

* 0074 



PROGRAM LISTINGS 



» DELTA 
(PAGE 2) 



• DELTA » 
**»**•••»•»»••••••***••* 

(PAGE 2) 



* X 


IS ANY FLOATING POINT NO. 














0075 


• 


















0076 


• IX 


IS ANY FIXED 


POINT NO. 














0077 


• 


















0078 


* 


















0079 


* OUTPUTS 


















0080 


* 


















0081 


* Y 


AS DESCRIBED 


IN ABSTRACT 














0082 


• 


















0083 


• IY 


AS DESCRIBED 


IN ABSTRACT 














0084 


* 


















0085 


• 


















0086 


» EXAMPLES 


















0087 


• 


















0088 


* 1. INPUTS - 


XU...6) * - 


2., -1., -O.t 0., 


l.t 


2. 










0089 


• 


IXU...6) « 


-2, -It -0, 0, 1, 


2 












0090 


* USAGES - 


DO 10 


1 = 1,6 














0091 


• 


Did) 


= DELTAF( X(I) 














0092 


* 


D2( I ) 


= DELTAFi IX ( I ) 














0093 


» 


ID1 ( I ) 


* XDELTAF( XU) 














0094 


» 


ID2 ( I ) 


» XDELTAF ( IX( I ) 














0095 


» 


SRI ( I ) 


* STEPRF( XU) 














0096 


* 


SR2 ( I ) 


= STEPRFUXU) 














0097 


• 


ISRH I 


) a XSTEPRF( Xd) 














0098 


• 


I SR2 ( I 


) = XSTEPRF( IX C I ) 














0099 


« 


SL1 ( I ) 


« STEPLFC XII) 














0100 




SL2 < I ) 


a STEPLFUX(I) 














0101 


» 


ISLK I 


) = XSTEPLFI XII) 














0102 


• 


I SL2 ( I 


) a XSTEPLF( IX I I ) 














0103 


• 


SCI ( I ) 


a STEPCF(XII)) 














0104 


» 


SC2( I ) 


a STEPCF(IXd) 














0105 


* 


I SCI ( I 


) = XSTEPCF(X( I ) ) 














0106 


» 


10 ISC2U 


) * XSTEPCF( IXU ) 














0107 


» OUTPUTS - 


Did. ..6) * 


D2( 1.. .6 ) * 0., 0 


1 


• t 


l.t 


0. 


t o. 




0108 


* 


IDK1...6) « 


ID2( 1...6) « 0, 


0, 1 


, 1 


t Ot 


0 






0109 


« 


SRK1...6) = 














1. 


0110 


* 


ISRK1...6) 


» SR2( 1...6) = 0, 


0, 


o, 


O f 1 


f 


1 




0111 


* 


SLU1...6) » 


SL2d...6) * 0., 


0., 


l.t 1. 


t 


l.t 


1. 


0112 


* 


ISL1U...6) 


= ISL2I1...6) » 0 


• 0, 


It 


It 


1, 


1 




0113 


* 


SCK1...6) a 














1. 


0114 


* 


ISC1U...6) 


a ISC2d...6) a o 


, o, 


0, 


It 


It 


1 




0115 


» 


















0116 


* 


















0117 


* PROGRAM FOLLOWS BELOW 
















0118 


* 


















0119 


• 


















0120 


• NO TRANSFER 


VECTOR 
















0121 


* 


















0122 


BCI 


1» DELTA 
















0123 


DELTA T2E 


GET 1L 


FIRST ENTRY 














0124 


XDELTA TZE 


GET1 


SECOND ENTRY 














0125 


GETZ PXD 


0,0 
















0126 


TRA 


It* 
















0127 


STEPL TZE 


GET1L 


ANOTHER 














0128 


STEPR TZE 


GETZ 


ANOTHER 














0129 


STEPC TMI 


GETZ 


ANOTHER 














0130 


GET1L CLA 


KIL 
















0131 


TRA 


ItA 
















0132 


XSTEPL TZE 


GET1 


ANOTHER 














0133 


XSTEPR TZE 


GETZ 


ANOTHER 














0134 


XSTEPC TMI 


GETZ 


ANOTHER 














0135 


GET1 CLA 


KD1 
















0136 


TRA 


1*4 
















0137 


KD1 PZE 


0,0,1 
















0138 


K1L DEC 


1.0 
















0139 


END 


















0140 



• DETRM * 
••••*#•*»•***•**•******* 

REFER TO 
SIMEQ 
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#*«###*##*##*#******»*»* 

RCEER TO 
SIMEQ 
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* DERI VA * * OERIVA * 

•***»****«*»*«•»»**••»*• **«**»#»*»•»•*»»»**«»••« 



DERIVA {SUBROUTINE) 
FAP 



9/29/64 LAST CARD IN DECK IS NO. 



•DERIVA 



COUNT 150 
LBL DERIVA 

ENTRY DERIVA ( YOFX, LY, DELX, DYDX, Y0FX1 ) 

* ABSTRACT 

* 

* TITLE - DERIVA 

» DERIVATIVE OF A VECTOR BY DIFFERENCING 

* 

» DERIVA FORMS A VECTOR, DYDX(I) 1*1. ..2Y , REPRESENTING 

* THE DERIVATIVE OF ANOTHER VECTOR, YOFX(I) 1*1. ..LY , 
» FROM THE DIFFERENCING FORMULAS 

* 

(Y0FX<2) - YOFX(i))/DELX 



( YOFX ( K4-1 ) - Y0FX(K-iJ/(2.0»D£LX) 

FOR K * 2,3,...,LY-i 
(YOFX(LY) - YOFX(LY~i))/DELX 



* LANGUAGE 

* EQUIPMENT 

* STORAGE 

* SPEED 
* 

* AUTHOR 



OYDX( 1 ) 
DYDX(K) 
DYUX(LY) 
WITH MINIMUM LENGTH OF LY * 2 

THE OUTPUT DYDXU...LY) MAY REPLACE THE INPUT YOFX. 

DERIVA HAS ONE OTHER OUTPUT Y0FX1 WHICH IT SETS* YOFXQK 
USING THIS QUANTITY IT IS POSSIBLE TO INVERT EXACTLY 
THE DIFFERENTIATED VECTOR DYDX , AND REOBTAIN YOFX. 
THIS INVERSION IS PERFORMED BY SUBROUTINE IDERIV, WHOSE 
CALLING SEQUENCE IS THE REVERSE OF THAT OF DERIVA. 

- FAP SUBROUTINE ( FORTRAN- 1 1 COMPATIBLE) 

- 709 OR 7090 (MAIN FRAME ONLY) 

- 61 REGISTERS 

- 7090 709 7090 709 

(68 OR 83) ♦ (39.4 OR 42.6)*LY MACHINE CYCLES 

- S.M. SIMPSON, AUGUST 1963 



» USAGE 

* 

* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 
• 

* FORTRAN USAGE 

* CALL DERIVA( YOFX, LY,DELX, DYDX, Y0FX1 ) 



INPUTS 

YOFX(I) 
LY 

DELX 
OUTPUTS 
DYDX(I) 



1=1. ..LY IS THE VECTOR TO BE DIFFERENTIATED 
SHOULD EXCEED I 

SHOULD BE NON-ZERO (MAY BE NEGATIVE) 

STRAIGHT RETURN WITH NO ACTION IF LY LSTHN 2 OR DELX * 0. 
1*1. ..LY IS GIVEN IN ABSTRACT 
EQU I VALENCE ( DYDX, YOFX ) IS PERMITTED 
IS SET * YOFX(l) 



* YOFXl 
* 

* EXAMPLES 
» 

* 1. BEHAVIOUR WITH VARIOUS DELX, LY VALUES 



• 


INPUTS 


- Yd.. 


.5) = 


2., 6., 14., 18. 


» 


» 




D4 = 


FY4 = 


05 * FY 5 * -999. 




» 


USAGE 




CALL 


DER I VA ( Y, 5, 1. 


t 


* 






CALL 


DERI VAC Y, 5, -2. 


» 


» 






CALL 


DER I VA( Y, 2, 1. 


t 


* 






CAL 


DERI VA( Y, 1, 1. 


• 


* 






CALL 


DER I VA ( Y, 5, 0. 


* 


* 


OUTPUTS 


- Did. 


..5) * 


s 4., 6., 6., 2., 


0 


* 




D2d. 


..5) = 


: — 2 . , — 3 • , — 3 • , — 1 • , 


0. 



18. 



D3, FY3) 



FY 1 * 
FY2 * 



0159 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
006 7 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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• DERI VA * * DERI VA * 
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• 


D3U..2) = 


4 


., 4. FY3 * 2. 


0075 


• 


04 = FY4 = 


D5 


» FY5 * -999. (NO OUTPUT CASES) 


0076 


» 








0077 


» 2. MULTIPLE 


DIFFERENTIATION 


1 WITH OUTPUT REPLACING INPUT 


0078 


• INPUTS - Yd. .,6) = 


4., 8., 12., 24., 20., 24. 


0079 


* USAGE 


DO 10 


1 = 1,3 


0080 


• 


10 CALL 


DERI VA( Y, 6, l.t Y, FY( 11) 


008 1 


* OUTPUTS - 


Yd. ..6) = 


2. 


, 0., -3., 0., 4., 4. 


0082 


* 


FY(1..*3) = 


4. 


t 4., 0. 


0083 


• 








0084 


• PROGRAM FOLLOWS BELOW 






0085 


» 








0086 


* NO TRANSFER 


VECTOR 






0087 


HTR 


0 




XR4 


0088 


BCI 


l.DERIVA 






0089 


* ONLY ENTRY. 


DERI VA( YOFX, 


LY, 


DELX, DYDX, YOFX 1 ) 


0090 


OERIVA SXD 


DERIVA-2,4 






0091 


* CHECK LY (GRTHN= 2) AND 


DELX (NON-ZERO) 


0092 


CLA* 


2,4 




LY 


0093 


TMI 


LEAVE 






0094 


PDX 


Ot 4 






0095 


TXL 


LEAVE, 4, 1 






0096 


TXI 


*+l , 4»-i 




LY— 1 


0097 


SXD 


TXL ?4 






0098 


LXD 


DERIVA-2,4 






0099 


CLA* 


3*4 DELX 






01 00 


TZE 


LEAVE 






0101 


• OK, SETUP 








0102 


STO 


REC2DX 






0103 


CLA 


FLP5 






0104 


FDP 


REC2DX 






0105 


STQ 


REC2DX 






0106 


CLA 


1,4 




A ( YflFX ) 


0107 


STA 


GET 






01 08 


SUB 


Kl 




A ( YOFX )-l 


01 09 


STA 


GET1 






0110 


CLA 


4,4 




A( DYDX 1 


0111 


STA 


STOI 






0112 


ADD 


Kl 




A ( DYDX ) +-1 


0113 


STA 


STORE 






0114 


• FORM DYDX(l) 


AND Y0FX1 






0115 


CLA* 


1»4 




YOFX( 1 ) 


0116 


STO 


OLDSTY 






0117 


STO* 


5,4 




TO YOFXl 


0118 


GET1 CLA 


*• 




«» s A(Y0FX)-1 Y0FX(2) 


0119 


STO 


MIDDLY 






0120 


FSB 


OLDSTY 




Y0FX(2)-Y0FX(1> 


0121 


FDP 


FLP5 






0122 


FMP 


REC2DX 




TIMES 1/DELX 


0123 


STOi STO 


»* 




** « A ( DYDX ) IS DYDX(l) 


0124 


* BYPASS LOOP 


IF LY IS 2 


(LY 


-1 IS 1) 


0125 


LXD 


TXL, 4 






0126 


TXL 


UPKl, 4,1 






0127 


* OTHERWISE PROCEED TO LOOP 




0128 


AXT 


2,4 






0129 


* LOOP TO SET 


DYDX(2,3...K... 


LY-1) K IN XR4 


0130 


GET LDQ 


**,4 




** * A(YOFX) 


0131 


CLS 


OLDSTY 






0132 


STQ 


OLDSTY 






0133 


FAD 


OLDSTY 




YCKd)-Y(K-l) 


0134 


XCA 








0135 


FMP 


REC2DX 




TIMES 1/2DELX 


0136 


STORE STO 


**,4 




** = A(DYDX)+1 IS DYDX(K) 


0137 


CLA 


MIDDLY 






0138 


LDQ 


OLDSTY 






0139 


STO 


OLDSTY 






0140 


STQ 


MIDDLY 






0141 


UPKl TXI 


•♦1,4,1 






0142 


TXL TXL 


GET, 4,** 




** * LY-1 


0143 


* NOW SET DYDX(LY). 




XR4 NOW = LY 


0144 


CLA 


MIDDLY 






0145 


FSB 


OLDSTY 




Y(LY)-Y(LY-1) 


0146 


FDP 


FLP5 






0147 


FMP 


REC2DX 




TIMES 1/DELX 


0148 


STO* 


STORE 




IS DYDX(LY) 


0149 
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* OERIVA * # DERIVA » 
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* EXIT 0150 
LEAVE LXD OERIVA-2,4 0151 

TRA 6,4 0152 

• CONSTANTS, TEMPORARIES 0153 
FLP5 DEC 0.5 0154 
Kl PZE 1 0155 

REC2DX PZE **,»*,*» i/(2»DELX) 0156 

MIDDLY PZE **,*«,*# HOLDS YOFX(K) INITIAL=Y0FX<2) 0157 

OLDSTY PZE **,»»,** HOLDS YOFX(K-l) INITIAL=Y0FX( I ) 0158 

END 0159 



«*•**•**•**••»»•»•*•**•* PROGRAM LISTINGS *»»«♦#»»*«#***»#*#»#♦»** 

* DIFPRS * » DIFPRS * 

»•**»*•*••***•*«•*••*••» •*•*•»*•**•*•«*•**••*•*• 



DIFPRS (SUBROUTINE) 
FAP 



9/29/64 LAST CARD IN DECK IS NO. 



•DIFPRS 



COUNT 100 
LBL DIFPRS 

ENTRY DIFPRS { X, LX, XPRSDF) 
ENTRY XDFPRS < I X , L IX , IXPRSD ) 

» 

* ABSTRACT 

» TITLE - DIFPRS WITH SECONDARY ENTRY XDFPRS 

» DIFFERENCE FIXED OR FLOATING VECTOR ELEMENTS IN PAIRS 

# 

» DIFPRS FORMS A FLOATING VECTOR WHOSE ELEMENTS ARE THE 

* DIFFERENCES OF SUCCESSIVE PAIRS OF THE ELEMENTS OF 

* ANOTHER FLOATING VECTOR, THE FIRST OUTPUT ELEMENT BEING 

* SET EQUAL TO THE FIRST INPUT ELEMENT. OUTPUT MAY REPLACE 

* INPUT. 
* 

* XDFPRS DOES THE SAME THING FOR FIXED VECTORS. 
* 

» DIFPRS AND XDFPRS ARE THE EXACT INVERSE OPERATORS OF 

* SUBROUTINES INTSUM AND XNTSUM RESPECTIVELY. 
* 

* LANGUAGE - FAP SUBROUTINES ( FORTRAN- 1 I COMPATIBLE) 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 

* STORAGE - 30 REGISTERS 

* SPEED - DIFPRS 30.6 + 12.4*LX MACHINE CYCLES, 

» XDFPRS 37.0 + 8.0*LX LX = VECTOR LENGTH 

« AUTHOR - S.M. SIMPSON, AUGUST 1963 

* 

* USAGE 

» 

* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 
* 

« FORTRAN USAGE 

* CALL DIFPRS( X, LX, XPRSDF) 

* CALL XDFPRS( IX, LIX, IXPRSD) 
* 

* INPUTS 
* 

* X(I ) 
* 

* LX 
♦ 

* IX(I) 
* 

* LIX 
* 

* OUTPUTS 



1=1... LX IS A FLOATING VECTOR INPUT TO DIFPRS 
SHOULD EXCEED 0 

1=1. ..LX IS A FIXED VECTOR INPUT TO XDFPRS. THE POSITION 
OF THE BINARY POINT IS ARBITRARY. 

SHOULD EXCEED 0 

STRAIGHT RETURN WITH NO OUTPUT IF LX OR LIX LSTHN 1 



XPRSDF(I) 1=1 
IXPRSD(I) 1=1.. .LX 



LX IS 

AND 



XPRSDF ( 1 ) = X( 1) 

XPRSDF(I) = X(I) - X(I-l) , 1=2. ..LX 



IS IXPRSD(l) = IXU) 
AND IXPRSDU) = IX ( I ) - IXU-l) 
WITH SAME BINARY POINT AS IX(I). 



1=2. ..LX 

EQUIVALENCE (XPRSDF, X) , ( IXPRSD, IX) IS PERMITTED. 



* EXAMPLES 



» i. INPUTS 
» USAGE 



OUTPUTS 



XU...4) = 1., 3., 6., 10. IXU...4) * 1,3,6,10 XDF3=0 

CALL DIFPRS( X,4, XDF1) 

CALL XDFPRS( IX, 4, IX0F1 ) 

CALL DIFPRS( X,4, X) 

CALL DIFPRSt X,l, XDF2 ) 

CALL 0IFPRS( X,0, XDF3) 
XDFK1...4) = 1., 2., 3., 4. 

XU...4) = 1., 2., 3., 4. 
XDF3 = 0. (NO OUTPUT CASE) 



IXDFK1...4) = 1,2,3,4 
XDF2 = 1. 



* 2. INPUTS - IXU...3) = OCT 000000000001, 000000000003, 000000000006 



0117 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
C072 
0073 
0074 
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• USAGE 


CALL 


XDFPRS( IX, 3, IX) 








0075 


» OUTPUTS - 


IXU...3) = 


OCT 000000000001 


, 000000000002, 


000000000003 


0076 


• 


















0077 


» PROGRAM FOLLOWS BELOW 














0078 


* 


















0079 


• NO TRANSFER 


VECTOR 














0080 




HTR 


0 




XR4 










0081 




BCI 


ltOIFPRS 














0082 


• PRINCIPAL ENTRY. DIFPRSCX 


,LX,XPRSDF) 








0083 


OIFPRS 


CLA 


FSB 














0084 


SETUP 


STO 


SUBTR 














0085 




SXO 


DIFPRS-2,4 














0086 


Kl 


CLA 


It* 




A(X) 










0087 




STA 


GET 














0088 




AOD 


Kl 




A(X)+1 








0089 




STA 


SUBTR 














0090 




CLA 


3,4 




AUPRSDF) 








0091 




STA 


STORE 














0092 




CLA» 


2,4 




LX 










0093 




TMI 


LEAVE 














0094 




PDX 


0,4 














0095 




TXL 


LEAVE, 4,0 














0096 




TXI 


•♦1,4,-1 




LX-1 










0097 




TXL 


LAST, 4,0 














0098 


• LOOP 


FOR ALL 


BUT XPRSDFU) 












0099 


GET 


CLA 


*»,4 




** s 


A(X) 








0100 


SUBTR 


NOP 






FSB 


**,4 OR 


SUB **,4 


»♦ 


» A(X)*1 


0101 


STORE 


STO 


**,4 




»* s 


A(XPRSOF) 








0102 




TIX 


GET,4,1 














0103 


* SET XPRSDFU) 














0104 


LAST 


LXD 


DIFPRS-2,4 














0105 




CLA* 


1,4 




X(l) 










0106 




STO* 


3,4 




XPRSDFi I) 








0107 


* EXIT 


















0108 


LEAVE 


LXO 


DIFPRS-2,4 














0109 




TRA 


4,4 














0110 


• SECOND ENTRY 


. XDFPRSUX, 


LIX, IXPRSD) 








0111 


XDFPRS 


CLA 


SUB 














0112 




TRA 


SETUP 














0113 


* CONSTANTS 
















0114 


FSB 


FSB 


*»,4 














0115 


SUB 


SUB 


**,4 














0116 




ENO 
















0117 
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* DISPLA (709) (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO, 0473 
» FAP 0001 
♦DISPLA (709) 0002 

COUNT 400 0003 

LBL DISPLA 0004 

ENTRY DISPLA 0005 

* 0006 

* ABSTRACT 0007 

» 0008 

* TITLE - DISPLA (709) 0009 
» WRITE HOLLERITH TEXT ON SCOPE 0010 
» 0011 

* DISPLA PRODUCES TITLES* LABELS, AND LEGENDS FOR SCOPE 0012 

* OISPLAYS. IT CAN PLOT 64 CHARACTERS IN EITHER LARGE (36 0013 

* CHARACTERS ACROSS THE SCOPE) OR SMALL (48 LETTERS ACROSS 0014 
» THE SCOPE) MODES IN EITHER A HORIZONTAL OR VERTICAL 0015 

* DIRECTION. 0016 

* 0017 
» LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0018 
» EQUIPMENT - 709 (MAIN FRAME AND SCOPE) 0019 

* STORAGE - 220 REGISTERS 0020 
» SPEED - 0021 
» AUTHOR - DISPLA IS A CONVERSION BY THE M.I.T. COMPUTATION CENTER OF 0022 

* THE SUBPROGRAM WRITE AS DESCRIBED IN M.I.T, LINCOLN LAB. 0023 
» MEMO. NO. 54-0003. THE VERSION HERE IS SLIGHTLY MODIFIED 0024 
» BY J. GALBRAITH (TO MAKE IT INVARIANT TO USE OR NON-USE OF 0025 

* STANDARD ERROR PROCEDURE). 0026 

* 0027 
» USAGE 0028 

* 0029 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0030 
» AND FORTRAN SYSTEM ROUTINES - ( IOH) 0031 

* 0032 
» FORTRAN USAGE 0033 
» CALL DISPLA 0034 
» PRINT 10, (LIST) 0035 
» 10 FORMAT (DISCON, FMT) 0036 

* 0037 

* INPUTS 0038 
» 0039 
» PRIMARILY WHAT APPEARS ON THE SCOPE IS WHAT WOULD HAVE BEEN 0040 

* WRITTEN BY THE PRINT STATEMENT WHICH FOLLOWS THE CALL DISPLA 0041 

* STATEMENT. HOWEVER, THE BEGINNING CHARACTERS (CALLED DISCON 0042 

* IN THE ABOVE FORMAT) OF THE FORMAT ARE USED TO CONTROL THE 0043 

* MODE OF THE DISPLAY. 0044 

* 0045 
» DISCON IS A VARIABLE LENGTH HOLLERITH FIELD 0046 

* 1. THE FIRST CHARACTER IS A CONTROL CHARACTER AND 0047 
» MUST BE ONE OF THE FOLLOWING 0048 

* 0049 
» CHARACTER ACTION CAUSED 0050 
» 0051 

* + SAME MODE AND ORIGIN. 0052 

* 0 (ZERO) SAME MODE, DOUBLE SPACE. 0053 

* (BLANK) SAME MODE, SINGLE SPACE. 0054 
» 1 CHANGE FILM FRAME, NEW MODE, 0055 

* NEW ORIGIN. 0056 

* 2 NEW MODE, NEW ORIGIN 0057 

* 0058 
» WHER€ MODE REFERS TO THE SIZE OF THE CHARACTERS 0059 
» AND TO THE DIRECTION OF PLOTTING, AND ORIGIN 0060 

* REFERS TO THE LOCATION OF THE FIRST CHARACTER 0061 

* OF THE LINE. 0062 
» 0063 

* IF THIS CHARACTER IS A +,0, OR BLANK, NO OTHER 0064 

* CHARACTERS ARE USED. 0065 

* 0066 

* 2. THE SECOND CHARACTER CONTROLS THE SIZE OF THE 0067 

* PLOTTED CHARACTERS. 0068 

* 0069 
» 8 BIG CHARACTERS (20 BY 28 SCOPE UNITS) 0070 

* S SMALL CHARACTERS (15 BY 21 SCOPE UNITS) 0071 
» 0072 
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3. THE THIRD CHARACTER CONTROLS THE DIRECTION OF 
PLOTTING. 



HORIZONTAL 
VERTICAL 



FMT 



LIST 



4. THE LAST SET OF INFORMATION CONSISTS OF TWO 0 TO 
4 DIGIT INTEGERS (GRTHN»0, LSTHN 1024) FOLLOWED 
BY COMMAS. THE FIRST INTEGER INDICATES THE 
X-COORDINATE ANO THE SECOND INTEGER THE Y- 
COORDI NATE (IN SCOPE UNITS) OF THE LOWER LEFT 
CORNER AT WHICH PLOTTING BEGINS. 

THERE MUST BE NO BLANKS BETWEEN ANY OF THESE CHARACTERS 

IMMEDI ATLY FOLLOWS DISCON 

IS THE STANDARD FORMAT FOR THE INFORMATION WHICH IS TO 

BE WRITTEN ON THE SCOPE. 
SHOULD NOT CALL FOR A LINE LONGER THAN 48 (FOR SMALL) OR 

36 (FOR BIG) CHARACTERS. IF A LINE GOES BEYOND THE 

EDGE OF THE SCOPE, THE END IS WRITTEN BEGINNING AT THE 

OPPOSITE EDGE. 

IS THE APPROPRIATE LIST WHICH CORRESPONDS TO FMT. 



THE FOLLOWING IS A LIST OF THE SPECIAL CHARACTERS AND THEIR OCTAL 



* EXAMPLES 
• 

* 1. EXAMPLE OF BIG, VERTICAL WRITING AND CHANGING THE FILM FRAME. 

* USAGE - CALL DISPLA 

* PRINT 10 

» 10 FORMAT(9H1BV10,10,21HBIG, VERTICAL WRITING) 

• 

» 2. EXAMPLE OF SMALL, HORIZONTAL WRITING ON SAME FILM FRAME. 

* USAGE - CALL DISPLA 
» PRINT 20 

* 20 F0RMAT(10H2SH120,90,25HSMALL, HORIZONTAL WRITING) 
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0073 
0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 



* 


EQUIVALENTS WHICH 


DISPLA 


WILL RECOGNIZE IN 


ADDITION TO THE 


0099 


* 


STANDARD CHARACTERS. 






0100 


* 










0101 


• 


APOSTROPHE 


14 


ARROW LEFT 


53 


0102 


• 


INTEGRAL SIGN 


15 


ALPHA 


55 


0103 


• 


SUMMATION SIGN 


16 


THETA 


56 


0104 


* 


APOSTROPHE 


17 


PI 


57 


0105 


* 


LOW POINT 


32 


SMALL SIGMA 


72 


0106 


• 


MIDDLE POINT 


35 


TAU 


75 


0107 


* 


CAP 


36 


PHI 


76 


0108 


• 


CUP 


37 


PSI 


77 


0109 


• 


ARROW RIGHT 


52 






0110 



0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
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OUTPUTS - 



SNALL? HORIZONTAL WRITING 



* 3. EXAMPLES OF ALL THE CHARACTERS , SINGLE SPACING AND DOUBLE SPACING 

* IN BOTH BIG AND SMALL. 

» INPUTS - AU...63) * OCT 0 16060606060, 026060606060, .776060606060 

* USAGE - CALL DISPLA 

* PRINT 30, (A(I), 1=1,16) 

* 30 FORMAT ( 10H1BH56»900, 16A2) 

* CALL DISPLA 

* PRINT 40, (A( I), 1=17,32) 

* 40 FORMAT ( 1H 16A2) 

* CALL DISPLA 

* PRINT 50, <A( I), 1=33, 48) 

* 50 FORMAT( 1H016A2) 

* CALL DISPLA 

* PRINT 60, (A( I), 1=49,63) 

* 60 FQRMAT( 10H28H56, 600, 16A2) 

* AND A SIMILAR SEQUENCE TO PLACE SMALL CHARACTERS IN 

* THE BOTTOM OF THE FRAME. 



0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
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OUTPUTS 



f i 1 2 3 4 5 6 7 S . 9 ? 
+ h B C D E F G H I 



- jKLMNOPQR*«-*cc-eiT 



T U V U X Y 2 or « < t 0 4' 



0 1 8 3 4 Si 7 8 9 ? ■ ' / P 

+ ABCDEFGM I . > 

-JKLMHOPOR**-"*^" 



» 4. 



S T U V U X Y Z <r * < t • ♦ 



EXAMPLE OF A LINE EXTENOING BEYOND THE EDGE OF THE SCOPE. 
USAGE - CALL DISPLA 

PRINT 70, ( A ( I ) , 1=1, 24) 
70 FORMAT ( 10H18H56, 500, 24A2 ) 

OUTPUTS - 



ID CI DB E3 F4 CB 6 



* 5. 



EXAMPLE OF DISPLAY SPACING UNDER FORMAT CONTROL 
USAGE - CALL DISPLA 

PRINT 80, (A( I), 1 = 1,63) 
80 FORMAT! 10H1BH56, 500, 16A2/1H 16A2/IH 16A2/1H 16A2) 

OUTPUTS - 




P2E 
BCI 

DISPLA CAL 
ANA 
TZE 



1, DISPLA 
1*4 

MASK2 
NOERR 



CHECK FOR STANDARD ERROR PROCEDURE 

MASK2=770377000000 
ZERO, NO STANDARD ERROR PROCEDURE 
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0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
0197 
0198 
0199 
0200 
0201 
0202 
0203 
0204 
0205 
0206 
0207 
0208 
0209 
0210 
0211 
0212 
0213 
0214 
0215 
0216 
0217 
0218 
0219 
0220 
0221 
0222 
0223 
0224 
0225 
0226 
0227 
0228 
0229 
0230 
0231 
0232 
0233 
0234 
0235 
0236 
0237 
0238 
0239 
0240 
0241 
0242 
0243 
0244 
0245 
0246 
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CAL 


US)) 


NOT ZERO, STANDARD ERROR PRESENT 


0247 




STA 


3,4 






0248 




TRA 


It* 






0249 


NOERR 


CAL 


US)) 






0250 




STA 


1»4 






0251 




WTV 








0252 




TRA 


1,4 






0253 




REM 








0254 




REM 








0255 




REM 


WOS - WRITE 


ON SCOPE 




0256 


(STVH) 


LDQ 


*+4 






0257 




CLA 


♦♦2 






0258 




TRA* $(IOH) 






0259 




MZE 


»»3 






0260 




TRA 


WOS 






0261 


wos 


SXD 


DISPLA-2 


,4 




0262 




SXA 


OUT+1,1 






0263 




SXA 


OUT+2,2 






0264 




CLA 


lf4 


FETCH PZE Z,,N. FORMAT WORDS ARE 


IN Z BSS N 


0265 




ARS 


18 






0266 




ADD 


lt4 






0267 




STA 


A 






0268 


(SVH) 


PDX 


W0S,1 






0269 




LXD 


MODE, 2 






0270 




TSX 


A, 4 


FETCH FIRST CHARACTER 




0271 




LXA 


A5,l 


IDENTIFY CONTROL CHARACTER 




0272 




AOD 


C f l 






0273 




TZE 


D,l 






0274 




TIX 


•-2,1,1 






0275 




TRA 


OUT 


ILLEGAL CONTROL CHARACTER 




0276 




REM 








0277 




TSX 


CFF,4 


TRANSFER VECTOR 




0278 




TRA 


NUORG 






0279 




ACL 


INCR,2 


m m 




0280 




ACL 


INCR,2 


m m 




0281 




ACL 


ORGIN 






0282 


0 


ANA 


MASK 






0283 




STO 


ORGIN 






0284 


TRACE 


LXD 


MODE, 2 






0285 




CAL 


ORGIN 


WRITE RECORD 




0286 




ACL 


6U3L,2 


MOVE POINT OF ORIGIN 




0287 


E 


ACL 


2R,2 


NEXT CHARACTER, MOVE POINT 




0288 




ANA 


MASK 




AND STORE 


0289 




SLW 


POINT 






0290 




TSX 


FETCH, 4 


FETCH CHARACTER 




0291 


A5 


PAX 


5,4 


IS IT BLANK 




0292 




SUB 


BLANK 






0293 




TNZ 


*+4 






0294 




CAL 


POINT 






0295 




ACL 


7R,2 






0296 




TRA 


E+l 






0297 




LDQ 


PAT, 4 


NO. FETCH PATTERN 




0298 




LXA 


A5,l 


DO 5 COLUMNS 




0299 




CAL 


POINT 






0300 


LP1 


ACL 


7D1R,2 


NEXT COLUMN, MOVE POINT 




0301 




LXA 


A7,4 


DO 7 ROWS 




0302 


LP2 


ADD 


1U,2 


NEXT ROW, MOVE POINT 




0303 




RQu 


1 


DO POINT 




0304 




TQP 


ELP2 






0305 




SLW 


POINT 


PLOT POINT 




0306 




STQ 


T 






0307 




CPY 


POINT 






0308 




LDQ 


T 






0309 


ELP2 


TIX 


LP2,4,1 






0310 




TIX 


LP1,1,1 


COLUMN DONE 




0311 




TRA 


E 


CHARACTER DONE 




0312 




REM 








0313 


A 


LDQ 


♦*tl 


NEW WORD *♦ = Z+N 




0314 




STQ 


WORD 






0315 




SXD 


WCNT,1 






0316 




LXA 


A7,l 






0317 




SXD 


CCNT,l 






0318 


FETCH 


LXD 


CCNT.l 






0319 




LDQ 


WORD 






0320 


( (S) ) 


PXD 


(STVH) 


STORAGE TO TV HOLLERITH 




0321 
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A6 


LGL 


6 




0322 




STQ 


WORD 




0323 




TIX 


B,l,l 




0324 




LXD 


WCNT,1 




0325 




TIX 


A, 1,1 




0326 


OUT 


LXD 


DISPLA-2,4 




0327 




AXT 


»*» 1 




0328 




AXT 


»»t2 




0329 




TRA 


2,4 




0330 


B 


SXD 


CCNT,1 




0331 




TRA 


lt4 




0332 




REM 






0333 


NUORG 


TSX 


FETCH, 4 


COMPUTE MODE 


0334 




STO 


T 


B OR S 


0335 




TSX 


FETCH, 4 


H OR V 


0336 




ADD 


T 




0337 




LRS 


i 




0338 




ARS 


4 




0339 




RND 






0340 


A7 


PAX 


7,2 


SV=4,BV=3,SH=2,BH=i 


0341 




SXD 


MODE, 2 




0342 




LXA 


A2,2 


COMPUTE ORIGIN 


0343 


R 


STZ 


T,2 




0344 




TSX 


FETCH, 4 




0345 




CAS 


TE>f 




0346 




NOP 






0347 


MODE 


TXI 


F , , »* 




0348 




STO 


T 




0349 




CLA 


T,2 




0350 


A2 


ALS 


2 




0351 




ADD 


T,2 




0352 




ALS 


1 




0353 




ADD 


T 




0354 




STO 


T,2 




0355 


WCNT 


TXI 


R+l , , *« 




0356 


F 


TIX 


Rt2,l 




0357 




CLA 


T-2 




0358 




ALS 


18 




0359 




ADD 


T~l 




0360 




STO 


ORG IN 




0361 


CCNT 


TXI 


TRACE, ,«» 




0362 


* 


SUBROUTINE TO CHANGE 


FILM FRAME 


0363 


CFF 


CFF 






0364 




TRA 


lt4 




0365 




REM 






0366 




DEC 


-1,-1,2,-48,32 


CC IS 1,2,0, ,+ 


0367 


C 


SYN 


• 




0368 




PZE 


6 


SV 


0369 




PZE 


8 


BV 


0370 




PZE 


t»6 


SH 


0371 




PZE 


,,8 


BH 


0372 


2R 


SYN 


« 




0373 




PZE 


t»30 


SV 


0374 




PZE 


t ,40 


8V 


0375 




PZE 


994 


SH 


0376 




PZE 


984 


BH 


0377 


INCR 


SYN 


* 




0378 




MZE 


♦ t3 


SV 


0379 




MZE 


,t4 


BV 


0380 




PZE 


3 


SH 


0381 




PZE 


4 


BH 


0382 


1U 


SYN 


* 




0383 




PZE 


3, ,21 


SV 


0384 




PZE 


4, ,28 


BV 


0385 




PZE 


1003, ,3 


SH 


0386 




PZE 


996,, 4 


BH 


0387 


7D1R 


SYN 


* 




0388 






21 


SV 


0389 






28 


BV 


0390 






t,2l 


SH 


0391 






tt28 


BH 


0392 


7R 


SYN 


• 




0393 




PZE 


1015, ,1006 


SV 


0394 




PZE 


1012, ,1000 


BV 


0395 




PZE 


18, ,1015 


SH 


0396 
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6U3L 



ORG IN 



PAT 

MASK 

MASK2 

BLANK 

TEN 

WORD 



PZE 


24» * 1012 




BH 






0397 


SYN 


# 










0398 


REM 












0399 


OCT 


1020774401 4 




77 


PS I 




0400 


OCT 


070427750434 




76 


PHI 




0401 


OCT 


020107422010 




75 


TAU 




0402 


OCT 


070424040000 


74 


( 




0199 


0403 


OCT 


001303400000 


73 






0200 


0404 


OCT 


141 104416010 




72 


SMALL SIGMA 




0405 


OCT 


303214461303 


71 


I 




0202 


0406 


OC T 


006047401003 


70 


Y 




0203 


0407 


OCT 


3062404051 43 


67 


x 




0204 


0408 


OCT 


376401010177 


66 


W 




0205 


0409 


OCT 


016306006007 


65 


v 




0206 


0410 


OCT 


177004020077 


64 


u 




0207 


0411 


OCT 


002017740201 


63 


T 




0208 


0412 


OCT 


105054464242 


62 


s 




0209 


0413 


OCT 


100200401002 


61 


/ 




0210 


0414 
0415 


OCT 


021700436010 




57 


PI 




0416 


OCT 


175114462276 




56 


THETA 




0417 


OCT 


141104414110 




55 


ALPHA 




0418 


OCT 


124343707052 


54 


* 




0215 


0419 


OCT 


02034250201 0 




53 


ARROW LEFT 




0420 


OCT 


020102507010 




52 


ARROW RIGHT 




0421 


OCT 


3761 1 1 452306 


51 


R 




0218 


0422 


OCT 


175015050336 


50 


Q 




0219 


0423 


OCT 


176 1 1 0447206 


47 


p 




0220 


0424 


OCT 


175014060276 


46 


0 




0221 


0425 


OCT 


3760702021 77 


45 


N 




0222 


0426 


OCT 


1 76070600577 


44 


M 




0223 


0427 


OCT 


1770040701 00 


43 


l_ 




0224 


0428 


OCT 


17A101710501 


42 






0225 


0429 


OCT 


1 01004020077 


41 


j 




0226 


0430 


OCT 


070 1 0040701 0 


40 






0227 


0431 


OCT 


040404010070 




37 


CUP 




0432 


OCT 


200401010100 




36 


CAP 




0433 


OCT 


000000400000 




35 


MIDDLE POINT 




0434 


OCT 


000004050434 


34 


) 




0231 


0435 


OC T 


001 406000000 


33 






0232 


0436 


OCT 


4000000 




32 


LOW POINT 




0437 


OCT 


000007740000 


31 


I 




0234 


0438 


OC T 


lift 100402 177 


30 


H 




0235 


0439 


OCT 


175014062371 


27 


G 




0236 


0440 


OCT 


376110440201 


26 


F 




0237 


0441 


OCT 


377114460301 


25 


E 




0238 


0442 


OCT 


203774060276 


24 


D 




0239 


0443 


OCT 


175014060242 


23 


C 




0240 


0444 


OCT 


203774462266 


22 


8 




0241 


0445 


OCT 


370221044574 


21 


A 




0242 


0446 


OCT 


020103702010 


20 


■»- 




0243 


0447 


OCT 


000130340000 




17 


APOSTROPHE 




0448 


OCT 


203435242343 




16 


SUMMATION SIGN 




0449 


OCT 


201003700201 




15 


INTEGRAL SIGN 




0450 


OCT 


000130340000 


14 APOSTROPHE 




0451 


OCT 


000241205000 


13 






0248 


0452 


OCT 


004015442206 




12 


QUESTION MARK 




0453 


OCT 


015114452236 


11 


9 




0250 


0454 


OCT 


155114462266 


10 


8 




0251 


0455 


OCT 


003610441203 


07 


7 




0252 


0456 


OCT 


171124462260 


06 


6 




0253 


0457 


OCT 


117054261271 


05 


5 




0254 


0458 


OCT 


060241137620 


04 


4 




0255 


0459 


OCT 


105014462266 


03 


3 




0256 


0460 


OCT 


345114462306 


02 


2 




0257 


0461 


OCT 


001027760000 


01 


I 




0258 


0462 


OCT 


175014060276 


00 


0 




0259 


0463 


OCT 


1777001777 










0464 


OCT 


770377000000 








0465 


BCD 


100000 










0466 


DEC 


10 










0467 


BSS 


1 










0468 


BSS 


1 










0469 


BSS 


1 










0470 


BSS 


1 










0471 
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POINT BSS 1 

END 



♦ OISPLA (709) * 
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0472 
0473 



»*«»»•«#•*•**•»•«»*»••»• PROGRAM LISTINGS **####*«»#*##»#*♦#*#»•»« 

» DISPLA (7090) * * OISPLA (7090) • 



►••»••*•*«•*•••*«»** •**#••**•»**»•*»*•«•»••• 

» DISPLA (7090) (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO. 0480 

* FAP 0001 
•DISPLA (7090) 0002 

COUNT 450 0003 
LBL DISPLA 0004 

ENTRY DISPLA 0005 

* 0006 

» ABSTRACT 0007 

» 0008 

* TITLE - DISPLA (7090) 0009 

* WRITE HOLLERITH TEXT ON SCOPE 0010 

* 0011 

* DISPLA PRODUCES TITLES* LABELS, AND LEGENDS FOR SCOPE 0012 

* DISPLAYS. IT CAN PLOT 64 CHARACTERS IN EITHER LARGE (36 0013 
» CHARACTERS ACROSS THE SCOPE) OR SMALL (48 LETTERS ACROSS 0014 

* THE SCOPE) MODES IN EITHER A HORIZONTAL OR VERTICAL 0015 

* DIRECTION. 0016 

* 0017 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0018 

* EQUIPMENT - 7090 (MAIN FRAME, DATA CHANNEL 0, AND SCOPE) 0019 
» STORAGE - 219 REGISTERS 0020 

* SPEED - 0021 

* AUTHOR - DISPLA IS A CONVERSION BY THE MIT COMPUTATION CENTER OF 0022 

* THE SUBPROGRAM WRITE AS DESCRIBED IN M.I.T. LINCOLN LAB 0023 

* MEMO. NO. 54-0003. 0024 

* 0025 

* USAGE 0026 

* 0027 

* TRANSFER VECTOR CONTAINS ROUTINES - FRAME 0028 

* AND FORTRAN SYSTEM ROUTINES - (IOH) 0029 
» 0030 
» FORTRAN USAGE 0031 

* CALL DISPLA 0032 

* PRINT 10, (LIST) 0033 
» 10 FORMAT (DISCON,FMT) 0034 

* 0035 

* INPUTS 0036 

* 0037 

* PRIMARILY WHAT APPEARS ON THE SCOPE IS WHAT WOULD HAVE BEEN 0038 

* WRITTEN BY THE PRINT STATEMENT WHICH FOLLOWS THE CALL DISPLA 0039 

* STATEMENT. HOWEVER, THE BEGINNING CHARACTERS (CALLED DISCON 0040 

* IN THE ABOVE FORMAT) OF THE FORMAT ARE USED TO CONTROL THE 0041 

* MODE OF THE DISPLAY. 0042 

* 0043 

* DISCON IS A VARIABLE LENGTH HOLLERITH FIELD 0044 

* 1. THE FIRST CHARACTER IS A CONTROL CHARACTER AND 0045 
» MUST BE ONE OF THE FOLLOWING 0046 

* 0047 

* CHARACTER ACTION CAUSED 0048 

* 0049 
» ♦ SAME MODE AND ORIGIN. 0050 

* 0 SAME MODE, DOUBLE SPACE. 0051 

* (BLANK) SAME MODE, SINGLE SPACE. 0052 

* 1 CHANGE FILM FRAME, NEW MODE, 0053 

* NEW ORIGIN. 0054 

* 2 NEW MODE, NEW ORIGIN 0055 
» 0056 
» WHERE MODE REFERS TO THE SIZE OF THE CHARACTERS 0057 
» AND TO THE DIRECTION OF PLOTTING, AND ORIGIN 0058 

* REFERS TO THE LOCATION OF THE FIRST CHARACTER 0059 
« OF THE LINE. 0060 

* 0061 

* IF THIS CHARACTER IS A +,0, OR BLANK, NO OTHER 0062 
» CONTROL CHARACTERS ARE USED. 0063 

* 0064 
« 2. THE SECOND CHARACTER CONTROLS THE SIZE OF THE 0065 
» PLOTTED CHARACTERS. 0066 

* 0067 

* B BIG CHARACTERS (20 BY 28 SCOPE UNITS) 0068 

* S SMALL CHARACTERS (15 BY 21 SCOPE UNITS) 0069 

* 0070 
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FMT 



LIST 



3. THE THIRD CHARACTER CONTROLS THE DIRECTION OF 

PLOTTING. 

H HORIZONTAL 
V VERTICAL 

(NOTE - VERTICAL MODE CHARACTERS READ 

CORRECTLY WHEN PICTURE IS ROTATED 

90 DEGREES CLOCKWISE) 

4. THE LAST SET OF INFORMATION CONSISTS OF TWO 0 TO 

4 DIGIT INTEGERS (GRTHN*0, LSTHN 1024) FOLLOWED 
BY COMMAS. THE FIRST INTEGER INDICATES THE 
X-COORDINATE AND THE SECOND INTEGER THE Y- 
COORDINATE (IN SCOPE UNITS) OF THE LOWER LEFT 
CORNER AT WHICH PLOTTING BEGINS. 

THERE MUST BE NO BLANKS BETWEEN ANY OF THESE CHARACTERS 

I MMED I ATLY FOLLOWS DISCON 

IS THE STANDARD FORMAT FOR THE INFORMATION WHICH IS TO 

BE WRITTEN ON THE SCOPE. 
SHOULD NOT CALL FOR A LINE LONGER THAN 48 (FOR SMALL) OR 

36 (FOR BIG) CHARACTERS. IF A LINE GOES BEYOND THE 

EDGE OF THE SCOPE, THE END IS WRITTEN BEGINNING AT THE 

OPPOSITE EDGE. 

IS THE APPROPRIATE LIST WHICH CORRESPONDS TO FMT. 



THE FOLLOWING IS A LIST OF THE SPECIAL CHARACTERS AND THEIR OCTAL 
EQUIVALENTS WHICH DISPLA WILL RECOGNIZE IN ADDITION TO THE 
STANDARD CHARACTERS. 



0071 
0072 
0073 
0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 



• 


APOSTROPHE 


14 


ARROW LEFT 


53 


0103 


» 


INTEGRAL SIGN 


15 


ALPHA 


55 


0104 


» 


SUMMATION SIGN 


16 


THETA 


56 


0105 


» 


APOSTROPHE 


17 


PI 


57 


0106 


• 


LOW POINT 


32 


SMALL SIGMA 


72 


0107 


* 


MIDDLE POINT 


35 


TAU 


75 


0108 


» 


CAP 


36 


PHI 


76 


0109 


• 


CUP 


37 


PSI 


77 


0110 


» 


ARROW RIGHT 


52 






0111 


* 










0112 


• 


EXAMPLES 








0113 


• 










0114 


* 


1. EXAMPLE OF BIG, VERTICAL WRITING 


AND CHANGING 


THE FILM FRAME. 


0115 


* 










0116 


» 


USAGE - CALL 


DISPLA 






0117 


• 


PRINT 


10 






0118 


* 


10 F0RMAT(9H1BV90,10 


,21HBIG, VERTICAL WRITING) 


0119 


* 










0120 


* 


2. EXAMPLE OF SMALL, HORIZONTAL WRITING ON SAME 


FILM FRAME. 


0121 



USAGE - CALL DISPLA 

PRINT 20 

20 F0RMAT(10H2SH120,90,25HSMALL, HORIZONTAL WRITING) 



0122 
0123 
0124 
0125 
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OUTPUTS 



SNALL* HORIZONTAL UR I T I HG 



• 3. 



EXAMPLES OF ALL THE CHARACTERS, SINGLE SPACING AND DOUBLE SPACING 
IN BOTH BIG AND SMALL. 

INPUTS - AU...63) = OCT 016060606060, 026060606060, ... 776060606060 

USAGE - CALL DISPLA 

PRINT 30, (AU),I = 1,16) 
30 FORMAT(10H1BH56,900,16A2) 
CALL DISPLA 

PRINT 40, (A( I ) , 1=17,32) 
40 FORMAT ( 1H 16A2) 
CALL DISPLA 

PRINT 50, <A(I),I=33,48) 
50 FORMAT ( 1H016A2 ) 
CALL DISPLA 

PRINT 60, (A( I ), 1=49,63) 
60 FORMAT( 10H2BH56, 600, 16A2) 
AND A SIMILAR SEQUENCE TO PLACE 



SMALL CHARACTERS IN 



THE BOTTOM OF THE FRAME. 



0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
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OUTPUTS 



f i 123456789 
+ HBCIiEFbH I 



- JK. LMN0PQR***c<8 



T U V U X Y 2 a ♦ < t 



♦ ABCDEFGHI . > ~ ~ 
-JKLMNOPOR**"«®» 



STUVUXYZ«*<t#* 



EXAMPLE OF A 
USAGE 



OUTPUTS - 



LINE EXTENDING BEYOND THE EDGE OF THE SCOPE* 
CALL DISPLA 

PRINT 70, ( A ( I ) , 1=1,24) 
70 FORMATt 10H1BH56, 500, 24A2 ) 



BO CI IE D F4 CB 6 7 3 9 



• 5. EXAMPLE OF DISPLAY SPACING UNDER FORMAT CONTROL 



USAGE 



OUTPUTS 



CALL DISPLA 

PRINT 80, <A( I), 1=1,63) 
80 F0RMAT(10H1BH56,500,16A2/1H 16A2/1H 16A2/1H 16A2) 




BSS 0 

» FOLLOWING CARD DESIGNATES THE DATA CHANNEL THAT CRT IS ATTACHED TO. 
* TO CHANGE, ALTER THE LETTER DESIGNATION ONLY AND REASSEMBLE. 

X TAPENO DL 

SCPAD EOU X-105 
PZE 
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0178 

0179 

0180 

0181 

0182 

0183 

0184 

0185 

0186 

0187 

0188 

0189 

0190 

0191 

0192 

0193 

0194 

0195 

0196 

0197 

0198 

0199 

0200 

0201 

0202 

0203 

0204 

0205 

0206 

0207 

0208 

0209 

0210 

0211 

0212 

0213 

0214 

0215 

0216 

0217 

0218 

0219 

0220 

0221 

0222 

0223 

0224 

0225 

0226 

0227 

0228 

0229 

0230 

0231 

0232 

0233 

0234 

0235 

0236 

0237 

0238 

0239 

0240 

0241 

0242 

0243 

0244 

0245 

0246 

0247 

0248 

0249 

0250 

0251 

0252 
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5> 








( PAC 




BCI 


I, DISPLA 




0253 


01 SPLA 


CAL 


1,4 


CHECK FOR STANDARD ERROR PROCEDURE 


0254 




ANA 


MASK2 


MASK2*770 377000000 


0255 




TZE 


NOERR 


ZERO, NO STANDARD ERROR PROCEDURE 


0256 




CAL 


( ( S) ) 


NOT ZERO, STANDARD ERROR PRESENT 


0257 




STA 


3,4 




0258 




TRA 


1,4 




0259 


NOERR 


CAL 


( ( S ) > 




0260 




STA 






0261 




TRA 


1,4 




0262 




REM 






0263 




REM 






0264 




REM 


WOS - WRITE ON 


SCOPE 


0265 


( STVH) 


LDQ 


•♦4 




0266 




CLA 


#♦2 




0267 




TRA* $UOH) 




0268 




MZE 


,,3 




0269 




TRA 


WOS 




0270 


wos 


SXD 


DISPLA-2,4 




0271 




SXA 


OUT+1, 1 




0272 




SXA 


OUT+2,2 




0273 




CLA 


1,4 FETCH PZE Z,,N. FORMAT WORDS ARE IN Z BSS 


N 0274 




ARS 


18 




0275 




ADD 


1,4 




0276 




STA 


A 




0277 


( SVH) 


PDX 


WOS,i 




0278 




LXD 


MODE, 2 




0279 




TSX 


A, 4 


FETCH FIRST CHARACTER 


0280 




LXA 


A5,l 


IDENTIFY CONTROL CHARACTER 


0281 




ADD 


CI 




0282 




TZE 


D,l 




0283 




TIX 


•-2,1,1 




0284 




TRA 


OUT 


ILLEGAL CONTROL CHARACTER 


0285 




REM 






0286 




TSX 


$F RAME ,4 




0287 




TRA 


NUORG 


• • 


0288 




ACL 


INCR,2 


# # 


0289 




ACL 


INCR,2 




0290 




ACL 


ORGIN 




0291 


D 


ANA 


MASK 




0292 




STO 


ORGIN 




0293 


TRACE 


LXD 


MODE, 2 




0294 




CAL 


ORGIN 


WRITE RECORD 


0295 




ACL 


6U3L,2 


MOVE POINT OF ORIGIN 


0296 


E 


ACL 


2R,2 


NEXT CHARACTER, MOVE POINT 


0297 




ANA 


MASK 


AND STORE 


0298 




SLW 


POINT 




0299 




TSX 


FETCH, 4 


FETCH CHARACTER 


0300 


A5 


PAX 


5,4 


IS IT BLANK 


0301 




SUB 


BLANK 




0302 




TNZ 


*+4 




0303 




CAL 


POINT 




0304 




ACL 


7R,2 




0305 




TRA 


E + l 




0306 




LDQ 


PAT, 4 


NO. FETCH PATTERN 


0307 




LXA 


A5,l 


DO 5 COLUMNS 


0308 




CAL 


POINT 




0309 


LP1 


ACL 


7DIR,2 


NEXT COLUMN, MOVE POINT 


0310 




LXA 


A7,4 


DO 7 ROWS 


031 1 


LP2 


ADD 


1U,2 


NEXT ROW, MOVE POINT 


0312 




ROL 


1 


DO POINT 


0313 




TQP 


ELP2 




0314 




SLW 


POINT 


PLOT POINT 


0315 




WRS 


SCPAD 




0316 




RCHX IOC 




0317 




TCOX * 




0318 


ELP2 


TIX 


LP2,4,1 




03 1 9 




TIX 


LP1,1,1 


COLUMN DONE 


0320 




TRA 


E 


CHARACTER DONE 


0321 




REM 






0322 


A 


LDQ 


»*,1 


NEW WORD ** = Z+N 


0323 




STQ 


WORD 




0324 




SXD 


WCNT,1 




0325 




LXA 


A7,l 




0326 




SXD 


CCNT,l 




0327 



5) 
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FETCH 


LXD 


CCNT, 1 




LDQ 


WORD 


{ (S) ) 


PXD 


ISTVH) f 0 


A6 


1GL 


6 




STQ 


WORD 




TIX 


B,l,l 




LXD 


WCNT, I 




TIX 


A, 1,1 


OUT 


LXD 


DISPLA-2,4 




AXT 


**♦ 1 




AXT 


»*,2 




TRA 


2,4 


B 


SXD 


CCNT,1 




TRA 


1,4 




REM 




NUORG 


TSX 


FETCH, 4 




STO 


T 




TSX 


FETCH, 4 




ADD 


T 




LRS 


1 




ARS 


4 




RND 




A7 


PAX 


7,2 




SXD 


M00E,2 




LXA 


A2,2 


R 


STZ 


T,2 




TSX 


FETCH, 4 




CAS 


TEN 




NOP 




MODE 


TXI 


F,,»* 




STO 


T 




CLA 


T,2 


A2 


ALS 


2 




ADD 


T,2 




ALS 


1 




ADD 


T 




STO 


T,2 


WCNT 


TXI 


R+l, ,*♦ 


F 


TIX 


R,2,i 




CLA 


T-2 




ALS 


18 




ADD 


T-l 




STO 


ORGIN 


CCNT 


TXI 


TRACE , , *» 




REM 






DEC 


-1,-1,2,-48,32 


C 


SYN 


• 




PZE 


6 




PZE 


8 




PZE 


,»6 




PZE 


,,8 


2R 


SYN 


* 




PZE 


,,30 




PZE 


,,40 




PZE 


994 




PZE 


984 


I NCR 


SYN 


• 




MZE 


,,3 




MZE 


,,4 




PZE 


3 




PZE 


4 


1U 


SYN 


• 




PZE 


3, ,21 




PZE 


4, ,28 




PZE 


1003, ,3 




PZE 


996, ,4 


7D1R 


SYN 


• 






21 






28 






,,21 






,,28 


7R 


SYN 


* 




PZE 


1015, ,1006 




PZE 


1012,, 1000 




PZE 


18, ,1015 
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0328 




0329 


STORAGE TO TV HOLLERITH 


0330 




0331 




0332 




0333 




0334 




0335 




0336 




0337 




0338 




0339 




0340 




0341 




0342 


COMPUTE MODE 


0343 


B OR S 


0344 


H OR V 


0345 




0346 




0347 




0348 




0349 


SV=4,BV^3,SH*2,BH*1 


0350 




0351 


COMPUTE ORIGIN 


0352 




0353 




0354 




0355 




0356 




0357 




0358 




0359 




0360 




0361 




0362 




0363 




0364 




0365 




0366 




0367 




0368 




0369 




0370 




0371 




0372 


CC IS 1,2,0, ,*• 


0373 




0374 


SV 


0375 


BV 


0376 


SH 


0377 


BH 


0378 




0379 


SV 


0380 


BV 


0381 


SH 


0382 


BH 


0383 




0384 


SV 


0385 


BV 


0386 


SH 


0387 


8H 


0388 




0389 


SV 


0390 


BV 


0391 


SH 


0392 


BH 


0393 




0394 


SV 


0395 


RV 


0396 


SH 


0397 


BH 


0398 




0399 


SV 


0400 


BV 


0401 


SH 


0402 
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6U3L 



ORG IN 



PAT 

MASK 

MASK2 

BLANK 

TEN 

WORD 



PZE 


24, ,1012 




BH 






0403 


SYN 


• 










0404 


REM 












0405 


OCT 


30207744014 




77 


PSI 




0406 


OCT 


070427750434 




76 


PHI 




0407 


OCT 


020107422010 




75 


TAU 




0408 


OCT 


070424040000 


74 


( 




0199 


0409 


OCT 


001303400000 


73 






0200 


0410 


OCT 


141104416010 




72 


SMALL SIGMA 




0411 


OCT 


303214461303 


71 


Z 




0202 


0412 


OCT 


006047401003 


70 


Y 




0203 


0413 


OCT 


306240405143 


67 


X 




0204 


0414 


OCT 


376401010177 


66 


W 




0205 


0415 


OCT 


016306006007 


65 


V 




0206 


0416 


OCT 


177004020077 


64 


u 




0207 


0417 


OCT 


002017740201 


63 


T 




0208 


0418 


OCT 


105054464242 


62 


S 




0209 


0419 


OCT 


100200401002 


61 


/ 




0210 


0420 
0421 


OCT 


021700436010 




57 


PI 




0422 


OCT 


175114462276 




56 


THETA 




0423 


OCT 


141104414110 




55 


ALPHA 




0424 


OCT 


124343707052 


54 


» 




0215 


0425 


OCT 


020342502010 




53 


ARROW LEFT 




0426 


OCT 


020102507010 




52 


ARROW RIGHT 




0427 


OCT 


376111452306 


51 


R 




0218 


042 8 


OCT 


175015050336 


50 


Q 




0219 


0429 


OCT 


376110442206 


47 


P 




0220 


0430 


OCT 


175014060276 


46 


0 




0221 


0431 


OCT 


376020202177 


45 


N 




0222 


0432 


OCT 


376020600577 


44 


M 




0223 


0433 


OCT 


377004020100 


43 


L 




0224 


0434 


OCT 


376101210501 


42 


K 




0225 


0435 


OCT 


101004020077 


41 


J 




0226 


0436 


OCT 


020100402010 


40 


- 




0227 


0437 


OCT 


040404010020 




37 


CUP 




0438 


OCT 


200401010100 




36 


CAP 




0439 


OCT 


000000400000 




35 


MIDDLE POINT 




0440 


OCT 


000004050434 


34 


) 




0231 


0441 


OCT 


001406000000 


33 






0232 


0442 


OCT 


4000000 




32 


LOW POINT 




0443 


OCT 


000007740000 


31 


I 




0234 


0444 


OCT 


376100402177 


30 


H 




0235 


0445 


OCT 


175014062371 


27 


G 




0236 


0446 


OCT 


376110440201 


26 


F 




0237 


0447 


OCT 


377114460301 


25 


F 




0238 


0448 


OCT 


203774060276 


24 


D 




0239 


0449 


OCT 


175014060242 


23 


C 




0240 


0450 


OCT 


203774462266 


22 


B 




0241 


0451 


OCT 


370221044574 


21 


A 




0242 


0452 


OCT 


020103702010 


20 


4- 




0243 


0453 


OCT 


000130340000 




17 


APOSTROPHE 




0454 


OCT 


203435242343 




16 


SUMMATION SIGN 




0455 


OCT 


201003700201 




15 


INTEGRAL SIGN 




0456 


OCT 


000130340000 


14 APOSTROPHE 




0457 


OCT 


000241205000 


13 






0248 


0458 


OCT 


004015442206 




12 


QUESTION MARK 




0459 


OCT 


015114452236 


11 


9 




0250 


0460 


OCT 


155114462266 


10 


8 




0251 


0461 


OCT 


003610441203 


07 


7 




0252 


0462 


OCT 


171124462260 


06 


6 




0253 


0463 


OCT 


117054261271 


05 


5 




0254 


0464 


OCT 


060241137620 


04 


4 




0255 


0465 


OCT 


105014462266 


03 


3 




0256 


0466 


OCT 


345114462306 


02 


2 




0257 


0467 


OCT 


001027760000 


01 


1 




0258 


0468 


OCT 


175014060276 


00 


0 




0259 


0469 


OCT 


1777001777 










0470 


OCT 


770377000000 








0471 


BCD 


100000 










0472 


DEC 


10 










0473 


BSS 


1 










0474 


BSS 


1 










0475 


BSS 


1 










0476 


BSS 


1 










0477 



•**»»••*«•*»***•»*•*•»»* 

» DISPLA (7090) » 



(PAGE 8) 

POINT BSS i 
IOC IOCD POINT,, I 
END 
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0478 
0479 
0480 



DIVIDE 



PROGRAM LISTINGS 



#••#••**•*»»«#****»••*#» 
• DIVIDE » 
#••»»*••••••**•••**•*«*» 



* DIVIDE (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO* 0087 

* FAP 0001 
♦DIVIDE 0002 

COUNT 150 0003 

LBL DIVIDE 0004 

ENTRY DIVIDE ( X,LX, XDVSR, XDVDED) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 
» TITLE - DIVIDE 0009 
» DIVIDE A FLOATING VECTOR BY A CONSTANT 0010 
» 0011 

* DIVIDE FORMS A VECTOR EQUAL TO A GIVEN VECTOR DIVIDED 0012 
» BY A FLTG CONSTANT. OUTPUT MAY REPLACE INPUT. 0013 

* 0014 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN— 1 1 COMPATIBLE) 0015 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0016 

* STORAGE - 23 REGISTERS 0017 

* SPEED - 7090 709 0018 

* 34 ♦ (19 OR 24)»LX MACHINE CYCLESt LX * VECTOR LENGTH 0019 

* 0020 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 0021 

* 0022 

* USAGE 0023 

* 0024 
» TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0025 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0026 
» 0027 
» FORTRAN USAGE 0028 

* CALL DIVIDE(X,LX, XDVSR, XDVDED) 0029 
» 0030 
» INPUTS 0031 

* 0032 

* X(I) 1*1. ..LX IS A FLTG VECTOR 0033 

* 0034 

* LX SHOULD EXCEED ZERO 0035 

* 0036 
» XDVSR IS A NON-ZERO FLTG QUANTITY. EQUIVALENCE! XDVSRt SOME X(I I) 0037 

* IS PERMITTED. 0038 
» 0039 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LX LSTHN 1 OR XDVSR*0» 0040 

* 0041 

* XDVDED(I) 1 = 1.. .LX HAS VALUES = XU)/XDVSR. 0042 

* EQUIVALENCE (XDVDED, X) IS PERMITTED. 0043 

* 0044 
» THE DIVISOR USED IS ALWAYS THE INITIAL VALUE OF XDVSR. 0045 

* 0046 
» EXAMPLES 0047 

* 0048 

* I. INPUTS - X(1...4)=l.,2.,3.,4. U*0.0 V=0.0 0049 

* USAGE - CALL DIVIDE( X,4, 2., Y I 0050 
» CALL DIVIDE(X,1,2.,Z) 0051 

* CALL DIVIDE(X,0,2.,U) 0052 
» CALL OIVIDE(X,l,0.,V) 0053 

* CALL DIVIDE(X,4,Xt2),X) 0054 

* OUTPUTS - Yd. ..4) = . 5, 1.0, 1.5,2.0 Z=0.5 0055 

* U*V=0.0 (NO OUTPUT CASES) X ( 1 . . .4)*. 5, 1. 0, 1. 5, 2. 0 0056 

* 0057 

* PROGRAM FOLLOWS BELOW 0058 

* 0059 

* NO TRANSFER VECTOR 0060 

HTR 0 XR4 0061 

BCI 1, DIVIDE 0062 

* ONLY ENTRY. DIVIDE ( X,LX, XDVSR, XDVDED) 0063 
DIVIDE SXD DIVIDE-2,4 0064 

Kl CLA 1,4 0065 

ADD Kl A(X)+i 0066 

STA GET 0067 

CLA 4,4 0068 

ADD Kl A(XDVDED)+1 0069 

STA STORE 0070 

CLA» 3,4 XDVSR 0071 

TZE LEAVE 0072 

STO TEMP 0073 

CLA* 2,4 LX 0074 
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• DIVIDE » 
*•»*»*•*«»«-*»#*•*•*•*•*» 
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TMI 


LEAVE 




* 0075 


PDX 


0,4 




0076 


TXL 


LEAVE, 4,0 




0077 


» DIVISION 


LOOP 




0078 


GET CLA 


*»,4 


**=A(xm 


0079 


FDP 


TEMP 




0080 


STORE STQ 


*«,4 


»*=A(XDVDED)+1 


0081 


TIX 


GET,4,1 




0082 


* EXIT 






0083 


LEAVE LXD 


DIVIDE-2,4 




0084 


TRA 


5,4 




0085 


TEMP PZE 


*« 9 »* t ** 


=DIVISOR 


0086 


END 






0087 



* DIVK * 
••••*••»*••*****•»•***•* 



PROGRAM LISTINGS 



REFER TO 
ADDK 



*•«•»**»»•*»»*«•**»••»* 

* DIVK 

•»«*•*»•••»**••*••«*»•* 

REFER TO 
ADDK 



*•*«»»***••**•»***«****» 

* DIVKS * 
*»»*»#**#*»#*»****♦*»»*» 

REFER TO 
ADDK 



»*•»*••»*•*****»•***•** 

» DIVKS 

»***#»*»*»*•*»•**»*»**• 

REFER TO 
ADDK 



««*••«*•«*****»***»»«**« 

• DO (PSEUDO ENTRY) « 
*«*•««•***»**»*«•*•»*•*« 

REFER TO 

SEVRAL 



**»•»««*•*•*• »**«»*».***» 

* CO (PSEUDO ENTRY) ♦ 
****««*•**»*****•»*»*«** 

REFER TO 
SEVRAL 
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DOTJ * # DOTJ * 

►••••***•••*•*••***• *••*«*•»•••*•*»»•••**•*» 



* DOTJ {SUBROUTINE) 10/2/64 LAST CARO IN DECK IS NO* 0142 

* FAP 0001 
•OOTJ 0002 

COUNT 100 0003 

LBL DOTJ 0004 

ENTRY OOTJ (LXY, IDX f X, IDY, Y, DOT, ADD, ORDER! 0005 

* 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - DOTJ 0009 

* VECTOR DOT PRODUCT WITH ARBITRARY INCREMENTS 0010 

* 0011 

* DOTJ EVALUATES THE FORMULAE 0012 

* 0013 

* DOT * XU)*Y(1) ♦ X< 1+I0X)»Y( 1 + IDY) 0014 

* + Xd+2*IDX)*Y(1+2»IDY) ♦ d> 0015 

* 0016 

* OR 0017 
« 0018 

* DOT = X(l)*Yd+(LXY~l)»IDY) «■'... 0019 

* ♦ X(U(LXY-l)*IDX)*Y(l) (2) 0020 

* 0021 

* FOR LXY TERMS OF X AND Y. THE INCREMENTS IOX AND IDY 0022 

* ARE INPUT PARAMETERS. 0023 

* 0024 
» LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0025 
« EQUIPMENT - 709 OR 7090 ( MAIN FRAME ONLY) 0026 

* STORAGE - 59 REGISTERS 0027 

* SPEED - ABOUT 18*LXY ♦ 72 MACHINE CYCLES ON THE 7090. 0028 
» AUTHOR - R.A. WIGGINS 3/63 0029 

* 0030 
» USAGE 0031 

* 0032 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0033 

* AND FORTRAN SYSTEM ROUTINES - NONE 0034 

* 0035 

* FORTRAN USAGE 0036 
» CALL DOTJ (LXY,IDX,X,IDY,Y, DOT, ADD, ORDER ) 0037 

* 0038 

* INPUTS 0039 

* 0040 
» LXY IS THE NUMBER OF TERMS IN X AND Y THAT ARE TO BE 0041 

* MULTIPLIED. 0042 
» MUST BE GRTHN- I 0043 

* 0044 
» IDX IS THE INCREMENT FOR X AS ILLUSTRATED IN THE ABSTRACT. 0045 

* MUST BE GRTHN* 0 0046 

* 0047 

* XU) I=1,...,(LXY-1)*IDX+1 IS THE X VECTOR. 0048 

* 0049 
» IDY IS THE INCREMENT FOR Y AS ILLUSTRATED IN THE ABSTRACT. 0050 

* MUST BE GRTHN= 1 0051 

* 0052 

* Yd) I=1,...,(LXY-1)*IDY+1 IS THE Y VECTOR. 0053 
» 0054 

* ADD IS GRTHN ZERO THE INPUT VALUE OF DOT IS ADDED TO THE 0055 
» DOT PRODUCT 0056 
» IF LSTHN-ZERO, DOT IS CLEARED BEFORE THE PRODUCT IS FOUND 0057 

* 0058 

* ORDER IF GRTHN ZERO FORMULA (1) OF THE ABSTRACT IS EVALUATED. 0059 

* IF LSTHN S ZERO FORMULA (2) OF THE ABSTRACT IS EVALUATED. 0060 

* 0061 
» OUTPUTS 0062 
» 0063 
» DOT IS THE DOT PRODUCT OF X AND Y AS DEFINED IN THE 0064 

* ABSTRACT. 0065 
» 0066 
» EXAMPLES 0067 

* 0068 
« 1. INPUTS - LXY-2 IDX=1 ADD=0 X { 1 . . . 2) = 1 . , 2. IDY»2 0069 

* Yd. ..3) = i.,2.,3. ORDER = i. 0070 
» OUTPUTS - DOT * 7. 0071 
» 0072 

* 2. INPUTS - LXY=2 IDX=3 XU...4) = l.,2.,3.,4. ADD=1. D0T»2. 0073 

* IDY=1 Yd. ..2) » l.,2.5 0RDER=1. 0074 
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• OOTJ * • OOTJ * 
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• 


OUTPUTS - DOT * 13. 


0075 


• 




0076 


• 


3. INPUTS - SAME AS EXAMPLE 2. EXCEPT ORDER=-l. 


0077 


• 


OUTPUTS - OOT-8.5 


0078 


• 




0079 


• 


4. INPUTS - LXY=i IDX=4 X(l)=2. IDY=7 Yll)=3. ADD*1. D0T*2. 


0080 


» 


ORDER=l. 


0081 


• 


OUTPUTS - DOT * 8. 


0082 


• 




0083 


• 


PROGRAM FOLLOWS BELOW 


0084 


• 




0085 



XR1 


PZE 






0086 


XR2 


PZE 






0087 


XR4 


PZE 






0088 




BCI 


ltDOTJ 




0089 


OOTJ 


SXO 


XR4,4 




0090 




SXO 


XR1,1 




0091 




SXD 


XR2.2 




0092 




LDQ 


=0 




0093 




CLA* 


7,4 


=ADD 


0094 




TLQ 


A2 




0095 




STZ* 


6,4 




0096 


A2 


CLA* 


lt4 


= LXY 


0097 




TLQ 


A3 




0098 




TRA 


LV 




0099 


A3 


SUB 


= 1B17 




0100 




STO 


LXY 




0101 




CLA* 


4,4 




0102 




TLQ 


A4 




0103 




TRA 


LV 




0104 


A4 


STD 


T2 




0105 




LDQ* 


8,4 


BORDER 


0106 




CAL* 


2,4 


= IDX 


0107 




TQP 


A5 




0108 




STO 


IDX 




0109 




SUB 


=0100000000000 




0110 




STO 


Tl 




0111 




LOQ 


IOX 




0112 




MPY 


LXY 




0113 




ARS 


1 




0114 




PAX 


,1 




0115 




TRA 


A6 




0116 


A5 


STO 


Tl 




0117 




AXT 


0,1 




0118 


A6 


CAL 


3,4 


=ADRU) 


0119 




STA 


X 




0120 




CAL 


5,4 


=ADR(Y) 


0121 




STA 


Y 




0122 




CAL 


6,4 


=ADR< DOT ) 


0123 




STA 


DOT 




0124 




STA 


DOT+1 




0125 




AXT 


0,2 




0126 




LXO 


LXY, 4 




0127 




TXI 


♦♦1,4,1 




0128 


X 


LDQ 


**,i 


»*=ADR(X) 


0129 


Y 


FMP 


**,2 


**=A0R(Y) 


0130 


DOT 


FAD 


** 


**=ADR{D0T) 


0131 




STO 


*» 


**=ADR(DOT) 


0132 


Tl 


TXI 


♦♦1,1,** 




0133 


T2 


TXI 


*+l,2,*» 




0134 




TIX 


X,4,l 




0135 


LV 


LXD 


XR1,1 




0136 




LXD 


XR2,2 




0137 




LXD 


XR4,4 




0138 




TRA 


9,4 




0139 


IOX 


PZE 




DECREMENT CONTAINS IDX 


0140 


LXY 


PZE 




DECREMENT CONTAINS LXY-l 


0141 




END 






0142 
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* DOTP » 
*»«*»***•***••••»•*»*•*» 



* DOTP (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0146 

* LABEL 0001 
CDOTP 0002 

SUBROUTINE DOTP ( NRA, NCA, AA f NRB, NCB t BB, IRB, ICB, DOT, ORDER ) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - DOTP 0007 

C DISPLACED DOT PRODUCT OF 2-DIMENS IONAL ARRAYS 0008 

C 0009 

C DOTP FINDS THE DISPLACED DOT PRODUCT OF TWO RECTANGULAR 0010 

C ARRAYS A(I,J) I«1,...,NRA J=1,...,NCA AND BU,J) 0011 

C I=1,...,NRB J=1,...,NCB ACCORDING TO THE FORMULAE 0012 

C 0013 

C MM 0014 

C DOT = SUM ( SUM I A< 1 1, J 1 )*B( I+IRB, J+ICB) ) ) 0015 

C I=-M J=-M 0016 

C 0017 

C WHERE IF 0018 

C ORDERS 1. 11=1 Jl*J 0019 

C ORDERS 2. Il-NRA-I+1 J l=J 0020 

C 0RD£R=-1. 11*1 J1*NCA-J+1 0021 

C 0RDER=-2. I1=NRA-I+1 J1=NCA-J+1 0022 

C AND 0023 

C M IS GRTHN MAX1NRA, NCA,NRB,NCB) (A AND B ARE 0024 

C CONSIDERED TO BE ZERO WHEN THE SUMMATION IS 0025 

C OUTSIDE THE RANGE OF DEFINITION) 0026 

C NRA,NCA, NRB,NCB,IRB, ICB, AND ORDER ARE INPUT 0027 

C PARAMETERS. 0028 

C 0029 

C DOTP EXITS WITH NO COMPUTATION IF ILLEGAL PARAMETERS 0030 

C ARE FOUND. 0031 

C 0032 

C LANGUAGE - FORTRAN II SUBROUTINE 0033 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0034 

C STORAGE - 264 REGISTERS 0035 

C SPEED - ABOUT .000029»NRA»NCA ♦ .000190*NCA ♦ .00078 SECONDS 0036 

C ON THE 7094 MOD 1. 0037 

C AUTHOR - R.A. WIGGINS MAY, 1963 0038 

C 0039 

C USAGE 0040 

C 0041 

C TRANSFER VECTOR CONTAINS ROUTINES - DOTJ 0042 

C AND FORTRAN SYSTEM ROUTINES - NONE 0043 

C 0044 

C FORTRAN USAGE 0045 

C CALL DOTP ( NRA, NCA, AA, NRB, NCB, 88, IRB, ICB, DOT, ORDER 1 0046 

C 0047 

C INPUTS 0048 

C 0049 

C NRA NUMBER ROWS IN A. 0050 

C MUST EXCEED 0 0051 

C 0052 

C NCA NUMBER COLUMNS IN A. 0053 

C MUST EXCEED 0 0054 

C 0055 

C AA(L) L=1,...,NRA»NCA CONTAINS AU,J) I=l,...,NRA J*1,*..,NCA 0056 

C STORED CLOSELY PACKED. 0057 

C 0058 

C NRB NUMBER ROWS IN B 0059 

C MUST EXCEED 0 0060 

C 0061 

C NCB NUMBER COLUMNS IN B 0062 

C MUST EXCEED ZERO 0063 

C 0064 

C BB(L) L*l .... ,NRB»NCB CONTAINS B(I,J) I*1,...,NRB J*1,*.#,NCB 0065 

C STORED CLOSELY PACKED. 0066 

C 0067 

C IRB DEFINES THE DISPLACEMENT ALONG THE COLUMNS OF A WITH 0068 

C RESPECT TO B BEFORE THE PRODUCT IS TAKEN. 0069 

C MAY BE ANY VALUE. 0070 

C 0071 

C ICB DEFINES THE DISPLACEMENT ALONG THE ROWS OF A WITH RESPECT 0072 

C TO B BEFORE THE PRODUCT IS TAKEN. 0073 
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C MAY BE ANY VALUE. 0074 

C 0075 

C ORDER DEFINES THE TYPE OF REVERSAL OF A THAT IS MADE BEFORE 0076 

C THE PRODUCT IS FOUND (SEE ABSTRACT) 0077 

C * 1. IMPLIES NO REVERSAL 0078 

C =2. IMPLIES COLUMN REVERSAL 0079 

C IMPLIES ROW REVERSAL 0080 

C =-2. IMPLIES ROW AND COLUMN REVERSAL 0081 

C 0082 

C OUTPUTS 0083 

C 0084 

C DOT CONTAINS THE DOT PRODUCT EVALUATED AS DEFINED IN THE 0085 

C ABSTRACT. 0086 

C 0087 

C EXAMPLES 0088 

C 0089 

C 1. INPUTS - NRA=4 NCA=4 NRB=4 NCB=4 IRB*0 ICB*0 ORDER-1. 0090 
C AAU...16) = 1.0,1.1, 1.2*1.1 BB( 1... 16)^1*0,0.9, 0.9, 0.8, 0091 
C 1.2,1.3,1.4,1.3 0.9,0.8,0.7,0.6, 0092 
C 1.2,1.5,1.5,1.3 0.7,0.7,0.5,0.4, 0093 
C 1.1,1.3,1.2,1.0 0.6,0.5,0.2,0.3 0094 

C WHERE AA AND BB ARE STORED BY COLUMNS. 0095 

C OUTPUTS - DOT * 12.84 0096 

C 0097 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT 0RDER=2. 0098 

C OUTPUTS - DOT = 12.95 0099 

C 0100 

C 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT 0RDER*-1. 0101 

C OUTPUTS - DOT = 12.87 0102 

C 0103 

C 4. INPUTS - SAME AS EXAMPLE 1. EXCEPT 0RDER=-2. 0104 

C OUTPUTS - DOT =» 13.07 0105 

C 0106 

C 5. INPUTS - SAME AS EXAMPLE 1. EXCEPT IRB=-2 ICB=-2 0RDER*-2. 0107 

C OUTPUTS - DOT = 4.17 0108 

C 0109 

C 6. INPUTS - SAME AS EXAMPLE 1. EXCEPT IRB=2 ICB=2 0110 

C OUTPUTS ~ DOT = 1.57 0111 

C 0112 

C PROGRAM FOLLOWS BELOW 0113 

C 0114 

DIMENSION AA(2),BB(2) 0115 

DOT^O. 0116 

J=l 0117 

C II IS VECTOR INDEX OF THE FIRST POINT IN BB. 0118 

I1=XMAX0F( 1,1+1 RBUXMAXOFCO, ICB*NRB) 0119 

C (2 IS VECTOR INDEX OF THE LAST POINT IN FIRST COLUMN OF BB. 0120 

I2=XMIN0F(NRA,NRA+IRB,NRB,NRB-IRB)-H 1-1 0121 

C LC IS THE LENGTH OF ROWS TO BE USED. 0122 

LC=XMINOF(NCA,NCA+ICB,NCB,NCB-ICB) 0123 

IF (XMIN0F( I2-Il+1,LC) ) 100,100,10 0124 

10 CONTINUE 0125 

C JA1+JA2+1 IS VECTOR INDEX OF FIRST POINT IN A FOR ORDER = 1. 0126 

JA1 » XMAX0F(0,-IRB> 0127 

JA2 = XMAXOF(0,-ICB*NRA) 0128 

Kl = ORDER+3. 0129 

IF (Kl-5) 20,20,100 0130 

20 GO TO (30, 40, 50, 50, 60), Kl 0131 

30 Jl = (NCA-LC+1)*NRA-JA1-JA2 0132 

J=-l 0133 

GO TO 70 0134 

40 Jl = (NCA-LC)«NRA+JA1-JA2+1 0135 

GO TO 70 0136 

50 Jl « JAI+JA2+1 0137 

GO TO 70 0138 

60 Jl » NRA+ JA2-J Al 0139 

Jx-1 0140 

70 CONTINUE 0141 

DO 90 1=11,12 0142 

CALL DOTJ I LC,NRA,AA( Jl) ,NRB,BB( I), DOT, 1., ORDER) 0143 

90 J1=J1+J 0144 

100 RETURN 0145 

END 0146 
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REFER TO 
BOOST 
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« DPRESS * 



REFER TO 
BOOST 
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* DSPFMT * • DSPFMT • 

**•*•••***•*•••*•**»*••• «* •#*••••*•••• »*•♦»»•##* 



* DSPFMT { SUBROUTINE ) 9/29/64 LAST CARD IN DECK IS NO* 0312 

* FAP 0001 
•DSPFMT 0002 

COUNT 310 0003 

LBL DSPFMT 0004 

ENTRY DSPFMT (CNTHOL, IORGX, IORGY, FMTEND,FMT> 0005 

* 0006 
» ABSTRACT 0007 

* 0008 
» TITLE - DSPFMT 0009 
» VARIABLE ORIGIN FORMAT GENERATOR FOR SCOPE SUBROUTINE DISPLA 0010 
» 0011 

* DSPFMT SETS UP A FORMAT FOR THE SUBROUTINE DISPLA WHICH 0012 

* ALLOWS THE USE OF A VARIABLE ORIGIN FOR THE ALPHANUMERIC 0013 

* CHARACTERS WHICH APPEAR ON THE SCOPE. 0014 

* 0015 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0016 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0017 

* STORAGE - 194 REGISTERS 0018 
» SPEED - 0019 

* AUTHOR - S.M. SIMPSON, NOVEMBER, 1961 0020 

* 0021 

* USAGE 0022 

* 0023 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0024 

* AND FORTRAN SYSTEM ROUTINES - NONE 0025 

* 0026 

* FORTRAN USAGE 0027 

* CALL DSPFMT ( CNTHOL, IORGX, IORGY, FMTEND, FMT ) 0028 

* 0029 

* INPUTS 0030 
» 0031 

* CNTHOL IS AN ALPHANUMERIC WORD CONTAINING PRECISELY 3 HOLLERITH 0032 

* LEFT ADJUSTED CHARACTERS* THESE ARE THE CHARACTERS 0033 
» USED TO CONTROL THE PLOTTING MODE OF DISPLA. 0034 

* 0035 

* IORGX IS THE X ORIGIN IN SCOPE UNITS. 0036 

* IS FORTRAN II INTEGER. 0037 
» MUST BE GRTHN=0, LSTHN 1024 0038 

* 0039 

* IORGY IS THE Y ORIGIN IN SCOPE UNITS. 0040 

* IS FORTRAN II INTEGER. 0041 

* MUST BE GRTHN=0, LSTHN 1024 0042 
» 0043 

* FMTEND(I) I«ltOt-ii... IS AN ARBITRARILY LONG VECTOR OF 0044 

* HOLLERITH CHARACTERS (6 PER WORD) THAT COMPLETES 0045 

* THE FORMAT CONTROLLING DISPLA. 0046 

* DOES NOT INCLUDE THE RIGHT PARENTHESIS. 0047 

* IS TERMINATED 8Y A FENCE (OCT 777777777777) 0048 

* MAY BE MOST EASILY SET UP BY USING A HOLLERITH 0049 

* ARGUMENT IN THE CALLING SEQUENCE. THEN FORTRAN 0050 

* TAKES CARE OF THE ORDERING AND THE FENCE. 0051 
» 0052 
» OUTPUTS 0053 

* 0054 

* FMT(I) 1^1,2,... IS THE HOLLERITH VECTOR OF THE COMPLETED 0055 

* FORMAT. 0056 
» IS OF LENGTH OF FMTEND PLUS THREE WORDS. 0057 

* 0058 

* EXAMPLES 0059 
» 0060 

* 1. INPUTS - CNTHOL = 3H2SH I0RGX=128 IORGY=1000 0061 

* USAGE - CALL DSPFMT (CNTHOL, IORGX, IORGY, 7H2I6,3A6, FMT) 0062 
» OUTPUTS - FMT(1.*.5) = 6H( 12H2SH 128, 1000, 2 1 6, 3A6 ) 0063 

* 0064 

* 2. USAGE - CALL DSPFMT ( 3H2SH, 10 , 2, 3H4A6, FMT ) 0065 

* OUTPUTS - FMTU...3) = 6H( 8H2SH10, 2, 4A6 ) 0066 

* 0067 
PZE 0068 
BCI 1, DSPFMT 0069 

DSPFMT SXD ♦-2, 4 0070 

SXA SV2,2 0071 

SXA SV1,1 0072 

•SET FMTEND 0073 

CAL 4,4 0074 



••••••»«*••»••»*•••••»*» PROGRAM LISTINGS #»•#*»»*»#»»»»»***«#•*•» 

* DSPFMT * * DSPFMT » 

•*•*•••**»•*••»•••*»***• •••#•••••*#••*****••**•» 
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SUB »1B35 0075 

STA ST50 0076 

•INITIAL STUFF ROUTINE FOR FIRST HOLERITH (LEFT PAREN ) 0077 

CLA Kl 0078 

STA KAY 0079 

STA EL 0080 

CLA 5,4 FMT 0081 

STA ST10 0082 

•PUT IN LEFT PAREN 0083 

CLA LPRN 0084 

TSX STUFF, 2 0085 

•GO FIND OUT HOW MANY DIGITS IN IRGX AND IN IRGY 0086 

CLA* 2,4 0087 

TSX BCI,2 0088 

STO NDX 0089 

CLA» 3,4 0090 

TSX BCI,2 0091 

STO NDY 0092 

•THE NUMBER OF DIGITS IN HOLERITH FIELD OF FMT IS 0093 

• * 3(F0R CONTROL) + NDX ♦ NDY + 2(F0R COMMAS) 0094 

ADD NDX 0095 

ADD K5 0096 

•SPREAD IT OUT IN HOLERITH AND STUFF INTO FORMAT 0097 

ALS 18 0098 

TSX BCI,2 0099 

TSX ST0RN,1 0100 

♦THEN PUT IN H 0101 

CLA AITCH 0102 

TSX STUFF, 2 0103 

•NOW SET UP AND INSERT 3 CONTROL HOLER ITH, STUFF SAVES 7 MQ) 0104 

LDQ« 1,4 0105 

LGL 6 0106 

TSX STUFF, 2 0107 

LGL 6 0108 

TSX STUFF, 2 0109 

LGL 6 0110 

TSX STUFF, 2 0111 

♦NEXT SET UP AND PUT IN IRGX 0112 

CLA» 2,4 0113 

TSX BCI,2 0114 

TSX ST0RN,1 0115 

♦THEN A COMMA 0116 

CLA COMMA 0117 

TSX STUFF, 2 0118 

♦THEN IRGY 0119 

CLA^ 3,4 0120 

TSX BCI,2 0121 

TSX ST0RN,1 0122 

♦THEN ANOTHER COMMA 0123 

CLA COMMA 0124 

TSX STUFF, 2 0125 

♦NOW KEEP PUTTING IN THE FORMAT END TILL HIT FENCE 0126 

AXT -1,1 0127 

ST50 CLA ♦♦,! ♦*=FMTEND 0128 

CAS FENCE 0129 

TRA *+2 0130 

TRA ST60 FENCE HIT, GO WIND UP 0131 

♦PUT IN ALL SIX 0132 

XCA 0133 

LGL 6 0134 

TSX STUFF, 2 0135 

LGL 6 0136 

TSX STUFF, 2 0137 

LGL 6 0138 

TSX STUFF, 2 0139 

LGL 6 0140 

TSX STUFF, 2 0141 

LGL 6 0142 

TSX STUFF, 2 0143 

LGL 6 0144 

TSX STUFF, 2 0145 

TIX ST50,1,1 0146 

♦WHEN FENCE HIT FILL IN RIGHT PAREN 0147 

ST60 CLA RPRN 0148 

TSX STUFF, 2 0149 



OSPFMT 
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•NOW FILL IN 


REMAINDER OF REGISTER WITH BLANKS( UNT IL KAY=1 ) 


0150 


ST70 


CLA 


KAY 


0151 




CAS 


Kl 


0152 




TRA 


•♦2 


0153 




TRA 


LV 


0154 


•(USING BLANK 


IN COMMA SINCE UNSURE OF BCI 1,(6 BLANKS ) 1 


0155 




CLA 


COMMA 


0156 




LRS 


6 


0157 




TSX 


STUFF, 2 


0158 




TRA 


ST70 


0159 


•EXIT 






0160 


LV 


LXD 


DSPFMT-2,4 


0161 


SV2 


AXT 


»*,2 


0162 


SVi 


AXT 


1 


0163 




TRA 


6,4 


0164 


•CONSTANTS 




0165 


NOX 


PZE 


NO. DIGITS 


0166 


NDY 


PZE 




0167 


LPRN 


BCI 


It ( 


0168 


RPRN 


BCI 


It ) 


0169 


COMMA 


BCI 


1, 


0170 


FENCE 


OCT 


777777777777 


0171 


AITCH 


BCI 


It H 


0172 


K5 


PZE 


5 


0173 


* 






0174 


•INTERNAL SUBROUTINES 


0175 


« 






0176 


•STORN 


STUFFS 


NO. FROM BCI INTO FMT BLOCK (IGNORE LEADING ZEROES! 


0177 


• A 


TSX STORN, 1 


0178 


» A*i 


RETURN 




0179 


STORN 


CLA 


84 


0180 




TNZ 


ST400 


0181 




CLA 


B3 


0182 




TNZ 


ST300 


0183 




CLA 


B2 


0184 




TNZ 


ST2O0 


0185 




TRA 


STIOO 


0186 


ST400 


CLA 


B4 


0187 




TSX 


STUFF, 2 


0188 


ST300 


CLA 


B3 


0189 




TSX 


STUFF, 2 


0190 


ST200 


CLA 


B2 


0191 




TSX 


STUFF, 2 


0192 


STIOO 


CLA 


Bl 


0193 




TSX 


STUFF, 2 


0194 




TRA 


It i 


0195 


• CALLING SEQUENCE FOR STUFF 


0196 


* 


(INTERNAL SUBROUTINE TO DSPFMT) 


0197 


♦ A 


TSX 


STUFF, 2 


0198 


• A+l 


RETURN 




0199 


» 






0200 


• 


STUFF 


STORES BITS 30-35 OF THE AC AS FOLLOWS. 


0201 


» 


L K=l K 


=2 K-3 K*4 K=5 K=6 


0202 


• 






0203 


* 


ETC 




0204 


* 






0205 


• 


3 




0206 


* 


2 




0207 


• FMT 


1 FMT ( 1 


tl) 


0208 


• 






0209 


•FL ANO KAY MUST BE SET TO i BY OSPFMT, ANO 


0210 


• FMT 


STORED 


IN ADDRESS OF STIOt BEFORE STUFF 


0211 


» IS FIRST USED. 


0212 


• 






0213 


• 


STUFF 


SHIFTS THE AC APPROPRIATELY, ADDS FMT(L), 


0214 


• ANO 


STORES 


RESULT AT FMT(L). IT THEN INCREMENTS 


0215 


• K, AND IF K 


GRTR THAN 6, INCREMENTS L AND RESETS K»l. 


0216 


♦ FOR 


K=l IT 


FIRST CLEARS FMT(L). 


0217 


STUFF 


ANA 


KANA GET RID OF ANY OTHER BITS 


0218 




STO 


TEMP AND STORE 


0219 




SXA 


STLV,2 


0220 




STQ 


SVMQ 


0221 




LXA 


EL, 2 L-l TO XR2 


0222 




TXI 


•♦1,2,-1 


0223 


• IF K= 


I CLEAR 


FMT(L) 


0224 
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CLA 


KAY 








0225 




CAS 


Kl 








0226 




TRA 


•4-2 








0227 




TRA 


ST3 








0228 




TRA 


ST4 








0229 


ST3 


STZ» 


STIO 








0230 


ST4 


CLA 


K6 








0231 




SUB 


KAY 








0232 




XCA 










0233 




MPY 


K6 








0234 




XCA 










0235 




STA 


ST9 








0236 




LOQ 


TEMP 




GET BITS BWS ZEROES 


0237 




LGL 


36 




IN MQ 




0238 


ST9 


LGL 


»# 




**=6 ( 6-K ) 




0239 


STIO 


ACL 


*»t 2 




»*=FMT XR2=L-1 




0240 




SLW* 


STIO 








0241 




CLA 


KAY 








0242 




ADO 


Kl 








0243 




STO 


KAY 








0244 




CAS 


K6 








0245 




TRA 


ST12 








0246 




NOP 










0247 




TRA 


STLV 








0248 




CLA 


Kl 




RESET K TO 1 




0249 




b I U 


KAY 




AND L TO L+l 




0250 




AOO 


EL 








0251 




STO 


EL 








0252 


STLV 


AXT 


*»,2 








0253 




LOQ 


SVMQ 








0254 




TRA 


l»2 








0255 


TEMP 


PZE 


** 




**=6 BITS TO BE 


STUFFED 


0256 


KAY 


PZE 


• » 




**=K 




0257 


EL 


PZE 


•» 




♦ ♦=L 




0258 


K6 


PZE 


6 








0259 


Kl 


PZE 


1 








0260 


KANA 


OCT 


77 








0261 


SVMQ 


PZE 


*• 








0262 




INTERNAL SUBROUTINE 


BCI 




0263 




TSX 


BCI, 2 




WITH FORTRAN INTEGER IN ACRETURN WITH 


0264 










BCI IN B1,B2,B3 


,B4, RIGHT ADJUSTED 


0265 










AC = NO DIGITS I 


ON EXIT UER0) = 1) 


0266 


BCI 


SXA 


BCIR,2 








0267 




STZ 


Bl 








0268 




STZ 


B2 








0269 




STZ 


B3 








0270 




STZ 


B4 








0271 




ARS 


18 








0272 




AXT 


0,2 








0273 




SUB 


=1000 








0274 




TMI 


♦♦2 








0275 




TXI 


•-2,2, 


1 






0276 




ADO 


= 1000 








0277 




SXA 


B4,2 








0278 




AXT 


0,2 








0279 




SUB 


= 100 








0280 




TMI 


»+2 








0281 




TXI 


*-2,2, 


1 






0282 




ADD 


= 100 








0283 




SXA 


B3,2 








0284 




AXT 


0,2 








0285 




SUB 


= 10 








0286 




TMI 


♦♦2 








0287 




TXI 


*-2,2, 


1 






0288 




ADD 


= 10 








0289 




SXA 


82,2 








0290 




STA 


Bl 








0291 


FIGURE OUT 


HOW MANY 


DIGITS 






0292 




CLA 


Kl 








0293 




NZT 


B4 








0294 




TRA 


*+3 








0295 




ADD 


K3 








0296 




TRA 


BCIR 








0297 




NZT 


B3 








0298 




TRA 


*+3 








0299 



»»*»•**•*•»•»•••••••»*•» 

* DSPFMT * 



PROGRAM LISTINGS 



»»**•»»••»*••*•»«••***• 

DSPFMT * 



(PAGE 5) 



I PAGE 5) 





ADD 


K2 




0300 




TRA 


BCIR 




0301 




ZET 


B2 




0302 




ADD 


Kl 




0303 


BCIR 


AXT 


♦ «*2 




0304 




TRA 


1*2 




0305 


B4 


PZE 


»• 


MOST SIG DIG 


0306 


63 


PZE 


*» 




0307 


B2 


PZE 


** 




0308 


Bl 


PZE 


** 


LEAST SIG DIG 


0309 


K2 


PZE 


2 




0310 


K3 


PZE 


3 




0311 




END 






0312 



••***•*•»»*••***•»***«*» PROGRAM LISTINGS 

» DU8LL * 
•*»***»**•*»•****«****»« 

REFER TO REFER TO 

DU8LX DU8LX 
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* OUBLX C SUBROUTINE ) 9/29/64 LAST CARD IN DECK IS NO. 0128 
» FAP 0001 
*DUBLX 0002 

COUNT 100 0003 

LBL DUBLX 0004 

ENTRY DUBLX (IX,LX) 0005 

ENTRY DUBLL (X,LX) 0006 

ENTRY HALVX (IX,LX) 0007 

ENTRY HALVL (X,LX) 0008 

« 0009 

* ABSTRACT 0010 

* 0011 
» TITLE - DUBLX , WITH SECONDARY ENTRY POINTS DUBLL, HALVX, HALVL • 0012 
» FAST DOUBLING OR HALVING OF A VECTOR (FIXED OR FLOATING) 0013 

* 0014 

* DUBLX DOUBLES THE MAGNITUDES OF THE NUMBERS IN A FIXED 0015 

* POINT VECTOR. OVERFLOW IS NOT CHECKED. 0016 

* 0017 
•' DUBLL DOUBLES THE MAGNITUDES OF THE NUMBERS IN A FLOATING 0018 

* POINT VECTOR. 0019 

* 0020 
» HALVX HALVES THE MAGNITUDES (WITHOUT ROUNDING) OF THE 0021 

* NUMBERS IN A FIXED POINT VECTOR. 0022 
» 0023 

* HALVL HALVES THE MAGNITUDES OF THE NUMBERS IN A FLOATING 0024 

* POINT VECTOR. 0025 

* 0026 
« LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0027 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0028 
» STORAGE - 45 REGISTERS 0029 

* SPEED - ION MACHINE CYCLES (N= LENGTH OF VECTOR) 0030 

* AUTHOR - S.M. SIMPSON 0031 

* 0032 

* USAGE 0033 

* 0034 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0035 
» AND FORTRAN SYSTEM ROUTINES - NONE 0036 

* 0037 

* FORTRAN USAGE 0038 

* CALL DUBLX (IX, LX) 0039 

* CALL DUBLL < X,LX) 0040 

* CALL HALVX (IX, LX) 0041 

* CALL HALVL ( X,LX) 0042 

* 0043 

* INPUTS 0044 

* 0045 

* X(I) 1=1.. .LX IS VECTOR OF FLOATING POINT NUMBERS. 0046 

* 0047 

* IX(I) 1*1. ..LX IS VECTOR OF FIXED POINT NUMBERS. 0048 

* 0049 

* LX IS FORTRAN II INTEGER 0050 

* MUST EXCEED ZERO 0051 
» (LX=0 IS TREATED AS LX=1, LX NEG AS LX POS) 0052 

* 0053 

* OUTPUTS 0054 
» 0055 

* X(I) 1=1. ..LX IS INPUT VECTOR HALVED OR DOUBLED. 0056 

* 0057 

* IXU) 1 = 1. ..LX IS INPUT VECTOR HALVED OR DOUBLED. 0058 

* 0059 
» EXAMPLES 0060 

* 0061 
» 1. INPUTS - IXU. ..3) = 1,~4,9 LX=3 0062 
» OUTPUTS - DUBLX IXU. ..3) = 2,-8,18 0063 

* HALVX IXU. ..3) = 0,-2,4 0064 

* 0065 

* 2. INPUTS - IXU. ..3) = OCT 000001000000,-000004000000,000011000000 0066 

* LX=3 0067 
» OUTPUTS - DUBLX IXU.. .3) = OCT 000002000000, -000010000000, 0068 

* 000022000000 0069 
« HALVX IXU. ..3) = OCT 000000400000, -000002000000, 0070 

* 000004400000 0071 
« 0072 

* 3. INPUTS - XU...3) = 1. ,-4. ,9. LX=3 0073 
» OUTPUTS - DUBLL XU...3) = 2. ,-8. ,18. 0074 
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* DUBLX * » OUBLX * 



2) 










(PAC 


y 




HALVL X<1. 


..3) « .5,-2. ,4.5 




0075 


y 










0076 


> 4. INPUTS 


- XU) = 3.17 


LX«1 




0077 


► OUTPUTS 


- DUBLL XU) 


= 6.34 




0078 


y 




HALVL XU) 


= 1.585 




0079 


y 










0080 




PIE 








0081 




BCI 


1 t DUBLX 






0082 


OUBLX 


CLA 


K3 


SET ALS 1 




0083 




STO 


D6 






0084 




TRA 


Dl 






0085 


HALVX 


CLA 


K5 


SET ARS 1 




0086 




STO 


D6 






0087 


Dl 


CLA 


K2 


SET CLA**, 4 




0088 




STO 


LOOP 


AND 




0089 




CLA 


K4 


STO**, 4 




0090 




STO 


D7 






0091 




TRA 


D5 






0092 


DUBLL 


CLA 


K8 


SET ACL KIO 




0093 




STO 


D6 






0094 




TRA 


D2 






0095 


HALVL 


CLA 


K9 


SET SUB KIO 




0096 




STO 


D6 






0097 


D2 


CLA 


K6 


SET CAL**, 4 




0098 




STO 


LOOP 


AND 




0099 




CLA 


K7 


SLW **,4 




0100 




STO 


D7 






0101 


05 


SXD 


DUBLX-2,4 


SAVE XR4 




0102 




CLA 


1»4 


SET Y+l 




0103 




ADD 


Kl 






0104 




STA 


LOOP 






0105 




STA 


C7 






0106 




CLA* 


2,4 


SET XR4 FOR N DATA 




0107 




PDX 


0,4 






0108 


y 






** BELOW-Y+l 




0109 


y 






DUBLX HALVX DUBLL 


HALVL 


OHO 


LOOP 


NOP 




CLA**, 4 CLA**, 4 CAL**, 


4 CAL**,4 


0111 




TZE 


D7+1 






0112 


D6 


NOP 




ALS I ARS 1 ACL KIO 


SUB KIO 


0113 


07 


NOP 




STO**, 4 STO**, 4 SLW**, 


4 SLW**,4 


0114 




TIX 


LOOP, 4,1 






0115 




LXD 


DUBLX-2,4 






0116 




TRA 


3,4 


EXIT 




0117 


Kl 


PZE 


1 






0118 


K2 


CLA 


**,4 






0119 


K3 


ALS 


1 






0120 


K4 


STO 


**,4 






0121 


K5 


ARS 


1 






0122 


K6 


CAL 


**,4 






0123 


K7 


SLW 


**,4 






0124 


K8 


ACL 


K10 






0125 


K9 


SUB 


KIO 






0126 


K10 


OCT 


001000000000 




0127 




ENO 








0128 



*•*«••••»••*•»•»*••**•*«« 

* ENDFIL * 



REFER TO 
REREAD 
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# ENDFIL 

*•*#*»»*»«•*•«**»•*»*« 

REFER TO 

REREAD 



» EOFSET * 



REFER TO 
REREAD 



«*•*«•*««««•**•»»«*»»*** 

« EOFSET ♦ 
#•*#**••»•**«#**»**••«•• 

REFER TO 

REREAD 
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EXCHVS * * EXCHVS * 

»•••••»••»••*••••»•» *••••*•••••*•••*••*•••«* 



EXCHVS I SUBROUTINE) 
FAP 



9/29/64 LAST CARD IN DECK IS NO. 



•EXCHVS 

COUNT 100 

LBL EXCHVS 

ENTRY EXCHVS (LXY,X,Y) 

» 

» ABSTRACT — 

* 

• TITLE - EXCHVS 

• EXCHANGE ANY TWO VECTORS 



LANGUAGE 

EQUIPMENT 

STORAGE 

SPEED 

AUTHOR 



EXCHVS EXCHANGES ANY TWO VECTORS 

- FAP SUBROUTINE ( FORT RAN— 1 1 COMPATIBLE) 

- 709 OR 7090 (MAIN FRAME ONLY) 

- 22 REGISTERS 

- 31 + 10*LXY MACHINE CYCLES, LXY = LENGTH OF VECTORS 

- S.M. SIMPSON, AUGUST 1963 

USAGE 



TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 
AND FORTRAN SYSTEM ROUTINES - (NONE) 

FORTRAN USAGE 

CALL EXCHVS(LXY,X,Y) 



INPUTS 

LXY 
X { I ) 
Y(I) 

OUTPUTS 

xm 

Yd) 



EXAMPLES 
1. INPUTS 
USAGE 



IS COMMON LENGTH OF THE TWO VECTORS, 
1=1. ..LXY IS A VECTOR IN ANY MODE 
1=1. ..LXY IS A VECTOR IN ANY MODE 



SHOULD EXCEED 0 



OUTPUTS - XU...3) 
1X2 - 5 
1X4 = 0 



STRAIGHT RETURN WITH NO ACTION IF LXY LSTHN 1 
1=1.. .LXY IS X(I) = INPUT VALUE OF Y(I) 
1=1. ..LXY IS Y(I) = INPUT VALUE OF X(I) 

EQUIVALENCE (X,Y) IS PERMITTED (SAME THING AS NO ACTION) 



XU...3) = I., 2., 3. 1X1(1. ..3)= 2, 4, 6 

1X2 =4 1X3 = 5 1X4 = 0 1X5 = 1 
CALL EXCHVSO, X, 1X1) 
CALL EXCHVSi 1, 1X2, 1X3) 
CALL EXCHVS(0,IX4,IX5) 
CALL EXCHVS(3, X, X) 
2, 4, 6 
1X3 = 4 
1X5 = 1 



1X1(1. ..3) = 1., 2., 3. 

(NO OUTPUT CASE) 



» PROGRAM FOLLOWS BELOW 



» NO TRANSFER VECTOR 



0083 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
002 3 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 





HTR 


0 


XR4 


0058 




BCI 


1, EXCHVS 




0059 


» ONLY 


ENTRY. 


EXCHVS(LXY, 


X,Y> 


0060 


EXCHVS 


SXD 


EXCHVS-2,4 




0061 




CLA 


2,4 




0062 




ADD 


Kl 


A(X)+1 


0063 




STA 


GET1 




0064 




STA 


STCRE1 




0065 




CLA 


3,4 




0066 




ADD 


Kl 


A(Y)+1 


0067 




STA 


GET2 




0068 




STA 


ST0RE2 




0069 


Kl 


CLA* 


lt4 


LXY 


0070 




TMI 


LEAVE 




0071 




PDX 


0,4 




0072 




TXL 


LEAVE, 4,0 




0073 



• EXCHANGE LOOP 



0074 
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GETl 


CLA 


•♦,4 


*# = 


AU) + 1 


0075 


GET2 


LOQ 


»*,4 


»* = 


A(Y)+l 


0076 


STORE2 


STO 


*»,4 




A(Y)+1 


0077 


STORE 1 


STQ 


♦ *,4 


** - 


A(X)+i 


0078 




TIX 


GETl, 4,1 






0079 


* EXIT 










0080 


LEAVE 


LXD 


EXCHVS-2,4 






0081 




TRA 


4,4 






0082 




END 








0083 
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» EXPAND < SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO. 0379 

» FAP 0001 

•EXPAND 0002 
COUNT 500 0003 
LBL EXPAND 0004 
ENTRY EXPAND (X, LX, MLPLYR, XPNDED, LXPNDD) 0005 

« 0006 

* 0007 

* ABSTRACT 0008 

* 0009 
» TITLE - EXPAND 0010 

* HI-SPEED EXPANSION OF A VECTOR UNDER CUBIC INTERPOLATION 0011 

* 0012 

* EXPAND TAKES A VECTOR OF LENGTH LX AND CREATES AN 0013 

* OUTPUT VECTOR OF LENGTH M«(LX-1)+1 IN WHICH THE FIRST* 0014 

* THE (M+D-TH, THE ( M*< LX-lHi )-TH VALUES ARE 0015 
» THE SAME AS THOSE OF THE INPUT VECTOR, AND IN WHICH THE 0016 

* REMAINING VALUES ARE INTERPOLATED WITH UNIFORM SPACING 0017 
» BY EXACT FITTING CUBICS, EXCEPT THAT QUADRATICS ARE USED 0018 

* AT THE TWO ENDS. THE EXPANSION FACTOR M IS AN INPUT 0019 

* PARAMETER GREATER THAN ZERO. LINEAR INTERPOLATION IS 0020 

* USED IF LX * 2 . A PURE COPY OCCURS IF LX = 1 OR IF 0021 
» M * 1 . 0022 

* 0023 
» LANGUAGE ~ FAP SUBROUTINE i FORTRAN-I I COMPATIBLE) 0024 
» EQUIPMENT - 709,7090,7094 (MAIN FRAME ONLY) 0025 
» STORAGE - 189 REGISTERS 0026 

* SPEED - ON THE 7090, EXPAND TAKES ABOUT 0027 

* 360+10*LX+800»(M-l)+94»(M-l)*LX MACHINE CYCLES, 0028 

* PROVIDED LX EXCEEDS 3 . 0029 

* AUTHOR - S.M. SIMPSON, JUNE 1964 0030 
» 0031 
» 0032 

* USAGE 0033 

* 0034 

* TRANSFER VECTOR CONTAINS ROUTINES - INTOPR 0035 

* AND FORTRAN SYSTEM ROUTINES - NOT ANY 0036 
» 0037 

* FORTRAN USAGE 0038 
« CALL EXPAND (X, LX, MLPLYR, XPNDED, LXPNDD) 0039 
» 0040 

* 0041 

* INPUTS 0042 
» 0043 

* XII) 1=1. . .LX IS THE VECTOR TO BE EXPANDED. 0044 

* 0045 

* LX SHOULD EXCEED ZERO. 0046 
» 0047 
» MLPLYR IS THE EXPANSION FACTOR, M, DESCRIBED IN ABSTRACT. 0048 
» SHOULD EXCEED ZERO. 0049 

* 0050 

* 0051 
» OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LX LSTHN* 0, OR IF 0052 

* LX EXCEEDS 1 BUT MLPLYR IS LSTHN- 0 . FOR 0053 
» LX - 1 XPNDEDU) IS SET = x( I) REGARDLESS OF 0054 

* MLPLYR. 0055 

* 0056 

* XPNDEDU) 1 = 1. • .LXPNDD IS THE EXPANDED VECTOR DESCRIBED IN 0057 
» ABSTRACT. IF MLPLYR = 1, XPNDED(I) » XU>. 0058 
» 0059 

* LXPNDD * MLPLYR*(LX-1)+1 IF LX EXCEEDS 1 . 0060 

* » 1 IF LX » I . 0061 

* 0062 

* 0063 
» EXAMPLES 0064 
» 0065 

* I. THIS EXAMPLE EXERCISES ALL PATHS IN EXPAND, EXCLUDING ILLEGAL LX 0066 
» AND MLPLYR VALUES, ON A SIMPLE LINEAR X SERIES. 0067 

* 0068 
» INPUTS - XC1...5) * 0. ,6. ,12. ,18. ,24. AND LET XPNDED BE A THREE 0069 

* DIMENSIONAL ARRAY OF DIMENSION XPNDED ( 16, 5, 3) , ALL 0070 

* ELEMENTS OF WHICH HAVE BEEN SET TO THE CONSTANT 0071 
» VALUE = -9.0 . 0072 

* USAGE - DIMENSION LXPNDD(5,3) 0073 
» DO 10 MLPLYR * 1,3 0074 
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* DO 10 LX » 1,5 0075 

* 10 CALL EXPAND (X, LX, MLPLYR, XPNDED U, LX, MLPLYR), 0076 

* 1 LXPNDD! LX, MLPLYR) I 0077 
» OUTPUTS - XPNDED! 1... 16, 1,1) = 0.,-9.,-9., ...,-9. 0078 

* XPNDED! 1... 16, 2,1) » 0. , 6. ,-9.,-9. , . . . ,-9. 0079 

* XPNDED! 1...16,3,l) = 0. , 6. , 12. ,-9. ,-9. , • ,-9. 0080 
» XPNDED(1...16,4,1) * 0., 6., 12., 18., -9. ,-9.,... ,-9. 0081 
» XPNDED! 1... 16,5,1) * 0.,6., 12., l8.,24.,-9.,-9.,.»*,-9. 0082 

* XPNDED<1...16,1,2) * 0.,-9.,...,-9. 0083 
» XPNDED ( 1...16,2,2) » 0.,3.,6.,-9.,...,-9. 0084 
» XPNDED!1...16,3,2) « 0. , 3. ,6. , 9. , 12. ,-9. , . . . ,-9. 0085 
» XPNDED(1...16,4,2) » 0. , 3. , . . . , 15. , 18. ,-9. , . . . ,-9. 0086 

* XPNDEDU...16,5,2) = 0. , 3. , . . . , 21. , 24. ,-9. , . . . ,-9* 0087 

* XPNDED(1...16,l,3) » 0.,-9.,...,-9. 0088 

* XPNDEDU...16,2,3) « 0. , 2. , 4. , 6. ,-9. , . . . ,-9. 0089 

* XPNDED!1...16,3,3) * 0. , 2 . , . . . , 10. , 12. ,-9. , . . . ,-9. 0090 

* XPNDED ( 1... 16,4, 3) = 0. , 2. , . . . , 16. , 18. ,-9. , . . . ,-9. 0091 

* XPNDED ( 1...16,5,3) = 0. , 2. , . . . ,22. , 24. ,-9. ,-9. ,-9. 0092 
» LXPNDDU...5,1...3) = 1, 2, 3, 4, 5, , 1 , 3, 5, 7, 9, , 1 ,4,7, 10, 13 0093 

* 0094 

* 2. ILLEGAL CALL STATEMENTS 0095 

* 0096 

* INPUTS - SAME AS EXAMPLE 1., EXCEPT LXPNDD - -9 0097 

* CALL EXPAND ! X,0, 3, XPNDED! 1,1,1 ), LXPNDD) 0098 

* CALL EXPAND ( X, 2,0, XPNDED! 1, I, 1) , LXPNDD) 0099 

* CALL EXPAND (X, -3,-1, XPNDED! 1,1, 1), LXPNDD) 0100 

* 0101 
» OUTPUTS - XPNDED!1...16,1.1) * -9. ,-9. , . . . ,-9. LXPNDD = -9 0102 

* 0103 

* 0104 

* PROGRAM FOLLOWS BELOW 0105 

* 0106 

* TRANSFER VECTOR CONTAINS INTOPR! NDATA, YLO, DELY, Y, OPER) 0107 
» 0108 

HTR 0 XR1 0109 

HTR 0 XR2 0110 

HTR 0 XR4 0111 

BCI 1, EXPAND 0112 

* 0113 

* ONLY ENTRY. EXPANDCX, LX, MLPLYR, XPNDED, LXPNDO) 0114 

* 0115 
EXPAND SXD EXPAND-4,1 0116 

SXD EXPAND-3,2 0117 

SXD EXPAND-2,4 0118 

* 0119 

* ADDRESS SETTINGS 0120 

* 0121 
CLA 1,4 A!X) 0122 
ADD Kl A!X)+1 0123 
STA CLAl 0124 
STA LDQl 0125 
SUB Kl A(X) 0126 
STA LDQ2 0127 
SUB Kl A(X)-l 0128 
STA LDQ3 0129 
SUB Kl A!X)-2 0130 
STA LDQ4 0131 
CLA 4,4 A! XPNDED) 0132 
ADD Kl A! XPNDED)+i 0133 
STA ST01 0134 
STA ST02 0135 

* 0136 
» CHECK OUT LX AND MLPLYR 0137 
» 0138 

CLA» 2,4 LX 0139 

STO LX 0140 

STD TXL1 0141 

CAS KD1 0142 

TRA LXGR1 0143 

TRA EVEN !LX « 1) 0144 

TRA LEAVE 0145 

LXGR1 CLA* 3,4 MLPLYR, CALLED M FOR SHORT 0146 

STO M 0147 

STD TXU 0148 

STD TXI2 0149 
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CAS 


KD1 








0150 




TRA 


MGR1 








0151 




TRA 


EVEN 




( M = I ) 




0152 




TRA 


LEAVE 








0153 


MGR1 


LRS 


18 








0154 




ORA 


OCTK 








0155 




FAD 


OCTK 




M FLOATED 




0156 




STO 


DELY 








0157 


• 












0158 


• INTERPOLATE 


BETWEEN X{1) 


AND 


X(2)» LX GRTHN* 2 • 




0159 


* 












0160 


LEFT 


CLA 


KD3 








0161 




STO 


NDAT A 




NDATA * 3 




0162 




CLA 


KD1 








0163 




STO 


I XLO 




IXLO 38 IFITLO 35 NSETS 


> 58 1 


0164 




STO 


IF I TLO 








0165 




STO 


NSE TS 








0166 




CLA 


LX 








0167 




SUB 


KD2 








0168 




TNZ 


TSXLFT 








0169 




CLA 


KD2 








0170 




STO 


NDAT A 




RESET NDATA TO 2 FOR 


LX * 2 


0171 


TSXLFT 


TSX 


TklTOn /. 

1 N I KP, 4 








0172 


• 












0173 


» INTEI 


RPOLATE 


BETWEEN X(2) 


AND 


X(LX-l), PROVIDED LX 


EXCEEDS 3 


0174 


* 












0175 


CENTER 


CLA 


KD4 








0176 




STO 


NDATA 




NDATA * 4 




0177 




CLA 


KD2 








0178 




STO 


I XLO 




IXLO * 2 (IFITLO STILL » 1) 


0179 




CLA 


LX 








0180 




SUB 


KD3 








0181 




STO 


NSE TS 




NSETS = LX-3 




0182 




TMI 


RIGHT 








0183 




TZE 


RIGHT 








0184 




TSX 


I NTRP ,4 








0185 


* 












0186 


• INTERPOLATE 


BETWEEN X(LX 


-1 ) 


AND X(LX), PROVIDED LX 


EXCEEDS 2 


0187 


* 












0188 


RIGHT 


CLA 


KD3 








0189 




STO 


NDATA 




NDATA = 3 




0190 




CLA 


KD1 








0191 




STO 


NSETS 




NSETS * 1 




0192 




CLA 


LX 








0193 




SUB 


KDl 








0194 




STO 


IXLO 




IXLO * LX-1 




0195 




SUB 


KDl 








0196 




STO 


IFITLO 




IFITLO = LX-2 




0197 




TMI 


EVEN 








0198 




TZE 


EVEN 








0199 




TSX 


INTRP,4 








0200 


• 












0201 


* FINALLY INSERT X(l,2,... 


,LX) 


INTO XPNDED( 1 ,M+ 1, . . . , M* ( LX- 1 ) +1 } 


0202 


» AND COMPUTE AND SET LXPNDD 




0203 


• 












0204 


EVEN 


AXT 


1,1 




I OF X ( n 




0205 




AXT 


1,2 




J OF XPNDED(J) 




0206 


CLA1 


CLA 


*», 1 




** = A(XJ+1 




0207 


STOl 


STO 


**,2 




*» = A ( XPNDED ) +1 




0208 


TXII 


TXI 


»+l ,2,«* 




*♦ = M 




0209 




TXI 


•♦It ltl 








0210 


TXL1 


TXL 


CLAl,l,»* 




** - LX 




0211 




LXD 


EXPAND-2,4 








0212 




CLA 


LX 








0213 




SUB 


KDl 








0214 




TNZ 


XCAIA 








0215 




CLA 


KDl 








0216 




TRA 


STOIA 








0217 


XCAIA 


XCA 










0218 




MPY 


M 








0219 




ALS 


17 








0220 




ADD 


KDl 








0221 


STOiA 


STO* 


5,4 




LXPNDD * I (LX=1), 


OR * M»(LX-1)+1 


0222 


• 












0223 
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» EXIT 
» 

LEAVE LXD 
LXD 
LXD 
TRA 



EXPAND-4,1 
EXPAND-3,2 
EXPAND-2,4 
6,4 



» INTERNAL SUBROUTINE INTRP 



LINKAGE XR4, RETURNS TO 1,4 



ASSUMES 



NDATA IS SET 
IXLO IS SET 
IFITLO IS SET 
NSETS IS SET 



2, 3, OR 4) 
(= 1, 2, OR LX-1) 
( IXLO OR IXLO-i) 
( = 1 OR LX-3) 



FORMS AND STORES INTERPOLATIONS (EXCLUDING ENDS) BETWEEN 
XUXLO) AND XtlXLOn) 

XUXLO+l) AND XdXLO + 2) 

ETC 

XUXLO+NSETS-l) AND X ( IXLO+NSETS > 
WHERE THE OPERATORS FOR THE FIRST SET ARE FITTED TO 

XUFITLO), XUFITLO+l), X ( IFITLO+NDATA-1 ) 



INTRP SXA 



INTSV4,4 



* FOR PURPOSES OF INTOPR, THE FIRST DATA POINT IS AT ARGUMENT 

» YLO = O.O, THE SECOND AT ARGUMENT = DELY = M, THE THIRD AT 

* 2M, ETC. HENCE THE Y FOR WHICH WE WANT AN OPERATOR IS Y * 1.0 

* (IN THE CASE THAT IFITLO « IXLO) OR Y = M+l (FOR 

* IFITLO * IXLO-1). THE TOTAL NUMBER OF DIFFERENT OPERATORS WE WANT 
» IS M-l • 

• 

» INITIALIZE Y, YCOUNT, DECREMENT AT TXL2, AND FRSXR2 



XCA 
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0224 
0225 
0226 
0227 
0228 
0229 
0230 
0231 
0232 
0233 
0234 
0235 
0236 
0237 
0238 
0239 
0240 
0241 
0242 
0243 
0244 
0245 
0246 
0247 
0248 
0249 
0250 
0251 
0252 
0253 
0254 
0255 
0256 
0257 
0258 
0259 



LDQ 


YLO 


(PREPARE FOR 


IFITLO = IXLO) 


0260 


CLA 


IXLO 






0261 


SUB 


IFITLO 






0262 


T2E 


XCA 






0263 


LDQ 


DELY 






0264 


XCA 








0265 


FAD 


K1L 






0266 


STO 


Y 


Y 




0267 


CLA 


KD1 






0268 


STO 


YCOUNT 


YCOUNT 




0269 


CLA 


IFITLO 






0270 


ADD 


NSETS 






0271 


SUB 


KD1 






0272 


STD 


TXL2 


DECREMENT AT 


TXL2 


0273 


CLA 


IXLO 






0274 


SUB 


KD1 






0275 


XCA 








0276 


MPY 


M 






0277 


ALS 


17 






0278 


ADD 


KD2 






0279 


STO 


FRSXR2 


FRSXR2 




0280 



» LOOP FOR SUCCESSIVE Y VALUES BEGINS HERE 
* 

* ACQUIRE OPERATOR, THEN INITIALIZE XR1,XR2 



0281 
0282 
0283 
0284 
0285 



STZ 


0PER3 


(CLEAR FOR CASES 


0286 


STZ 


0PER4 


NDATA » 2 OR 3) 


0287 


SXA 


GETSV4,4 




0288 


TSX 


$INT0PR,4 




0289 


TSX 


NDATA ,0 




0290 


TSX 


YL0,0 




0291 


TSX 


DELY,0 




0292 


TSX 


Y,0 




0293 


TSX 


OPERl.O 




0294 


AXT 


♦ *,4 


•» * XR4 PRIOR TO INTOPR 


0295 


LXD 


IFITLO, 1 




0296 


LXD 


FRSXR2,2 




0297 



0298 
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• INNER LOOP 


OVER THE SETS TO 


FORM 




0299 


• 










0300 


* X(I)*OPERl ♦ XU + l)*OPER2 


♦ XU+2)*0PER3 ♦ X(I+3)*0PER4 


0301 


« 










0302 


• RESULT 


IS STORED IN XPNDED(J) 




0303 


* ASSUMES 


I IS IN XRl, 


J IS 


IN XR2 


0304 


* 










0305 


* I 


JUMPS BY 1, J JUMPS 


BY 1 


M 


0306 


* 










0307 


E VAL 


STZ 


SUM 






0308 


L0Q1 


LDQ 


**t I 


»♦ ss 


A ( X )+l 


0309 




FMP 


OPER1 






0310 




FAD 


SUM 






0311 




STO 


SUM 






0312 


LDQ2 


LOQ 


*»»1 




A ( X ) 


0313 




FMP 


OPER2 






0314 




FAD 


SUM 






0315 




STO 


SUM 






0316 


LD03 


LDQ 


**, 1 


ft* ss 


A(X)-l 


0317 




FMP 


OPER3 






0318 




FAD 


SUM 






0319 




STO 


SUM 






0320 


LDQ4 


LDQ 


**tl 


ft* = 


A(X)-2 


0321 




FMP 


0PER4 






0322 




FAD 


SUM 






0323 


ST02 


STO 


♦*,2 


ft* - 


A(XPNDED)+1 


0324 


TXI2 


TXI 


•♦1,2,** 


»• SB 


M 


0325 




TXI 


•♦1,1,1 






0326 


TXL2 


TXL 


EVAL,1,»* 


*• as 


IFITLO+NSETS-l 


032 7 


• 










0328 


• RESET FOR 


ANOTHER Y VALUE AND CHECK COMPLETION 


0329 


• 










0330 




CLA 


FRSXR2 


INCREASE INITIAL OUTPUT STORAGE BY 1 


0331 




ADD 


KD1 






0332 




STO 


FRSXR2 






0333 




CLA 


Y 


INCREMENT Y BY 1.0 


0334 




FAD 


KIL 






0335 




STO 


Y 






0336 




CLA 


YCOUNT 


INCREMENT AND CHECK Y COUNTER 


0337 




ADD 


KD1 


(1.. 


• M-l) 


0338 




STO 


YCOUNT 






0339 




CAS 


M 






0340 




HPR 


• 


( IMPOSSIBLE) 


0341 




TRA 


INTSV4 


DONE 




0342 




TRA 


GETOPR 


MORE 


Y VALUES 


0343 


* 










0344 


* EXIT 


FROM 


INTERNAL SUBROUTINE 




0345 


• 










0346 


I NTSV4 


AXT 


**,4 


♦ ♦ = 


XR4 AT START OF INTRP 


0347 




TRA 


L.4 






0348 


» 










0349 


• CONSTANTS 








0350 


• 










0351 


Kl 


PZE 


1 






0352 


KOI 


PZE 


0,0,1 






0353 


KD2 


PZE 


0,0,2 






0354 


KD3 


PZE 


0,0,3 






0355 


KD4 


PZE 


0,0,4 






0356 


KIL 


DEC 


1.0 






0357 


YLO 


DEC 


0.0 






0358 


OCTK 


OCT 


233000000000 






0359 


• 










0360 


» TEMPORARIES 






0361 


• 










0362 


IXLO 


PZE 


0,0,** 


• • = 


It 2, OR LX-1 


UJ03 


IFITLO 


PZE 


0,0,** 


*» = 


IXLO OR IXLO-1 


0364 


NSETS 


PZE 


0,0,** 


*» = 


1 OR LX-3 


0365 


M 


PZE 


0,0,** 


** ss 


M * MLPLYR 


0366 


LX 


PZE 


0,0,** 


• » ss 


LX 


0367 


NOATA 


PZE 


0,0, ** 


»* = 


2, 3, OR 4 


0368 


DELY 


PZE 


** y ft*, *• 


• * = 


FLOATF(M) 


0369 


Y 


PZE 


«* , »» t ft* 


*• 3 


DELY*( IXLO-IFITLOm, 


0370 


* 










0371 


YCOUNT 


PZE 


0,0,** 


• * = 


1,2,..., M— 1 


0372 


FRSXR2 


PZE 


0,0,** 


• * = 


M*( IXLO-n + 2 (♦3,+4,...,+M) 


0373 
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0PER4 PZE *»,»»,## 0374 

0PER3 PZE #*,♦*,#* 0375 

0PER2 PZE *#,*»,*# 0376 

0PER1 PZE **,*#,«» 0377 

SUM PZE »#,»♦,** 0378 

END 0379 
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* FACTOR (SUBROUTINE) 9/8/64 LAST CARD IN DECK IS NO. 0488 

* FAP 0001 
♦FACTOR 0002 

COUNT 450 0003 

LBL FACTOR 0004 

ENTRY FACTOR (SPECT,N,L, WAVE, SPACE) 0005 

* 0006 
» 0007 
» ABSTRACT 0008 

* 0009 
» TITLE - FACTOR 0010 
» FACTOR POWER SPECTRUM TO FINO MINIMUM PHASE WAVELET 0011 

* 0012 

* FACTOR USES THE METHOD OF KOLMOGOROV (REF.- 1. ROBI NSON,E» 0013 

* A., M.I.T. PH.D. THESIS, GEOPHYSICAL ANALYSIS GROUP REPORT 0014 

* 7,1954. 2. SIMPSON ET AL., SCIENTIFIC REPORT NO. 2 OF 0015 

* CONTRACT AF 19(604)7378.) TO FACTOR THE POWER SPECTRUM 0016 

* AND THUS PRODUCE THE MINIMUM PHASE WAVELET. 0017 
» THE RESTRICTIONS ON APPLICABILITY OF THE METHOD REQUIRE 0018 

* THAT THE INPUT SPECTRUM BE NON-NEGATIVE AND NON-ZERO. 0019 

* HENCE SPECT(I), THE INPUT SPECTRUM, IS CHECKED AND ANY 0020 

* VALUES WHICH ARE LESS THAN l0»»(-6) OF THE MAXIMUM VALUE 0021 

* OF SPECTU) ARE SET EQUAL TO 10**<-6) OF THE MAXIMUM. I THIS 0022 

* FEATURE MAY EASILY BE REMOVED FROM THE SYMBOLIC DECK). 0023 

* 0024 

* ONE HALF OF THE NATURAL LOG OF THE SPECTRUM IS COMPUTED 0025 

* AND EXPANDED IN A COSINE SERIES. THE COEFFICIENTS OF THE 0026 
» EXPANSION ARE COMPUTED BY TRAPEZOIOAL RULE INTEGRATION 0027 

* (SAME AS TRIGONOMETRIC INTERPOLATION. HENCE THE FIRST AND 0028 
» LAST TERMS IN THE SPECTRUM ARE WEIGHTED BY 1/2 AND THE 0029 

* SUMMATION AND COSINE WEIGHTING ARE DONE SIMULTANEOUSLY 0030 

* BY SUBROUTINE COSP. THE COEFFICIENTS OF THE COSINE 0031 

* EXPANSION ARE TRAN(I), 1=1, L. THE EXPONENTIAL 0032 
» 0033 
» L 0034 

* EXP«*CTRAN(1)+ SUM(TRAN(I)*(Z»»(I-1)))) 0035 
» 1-2 0036 

* 0037 

* MUST BE EXPANDED IN A CONTINUED PRODUCT OF POLYNOMIALS IN 0038 

* Z. THE POLYNOMIALS ARE THEN MULTIPLIED OUT AND GROUPED IN 0039 

* THE FORM 0040 

* 0041 
» L 0042 
» P « SUM (W(I)»(Z»*(I-1))) 0043 

* 1=1 0044 

* 0045 
» WHERE L IS THE LENGTH OF THE WAVELET, AND W(I) IS THE 0046 
» DESIRED WAVELET. 0047 
» 0048 

* PROGRAM NOTES - 0049 

* THE EXPANSION OF THE EXPONENTIAL AND MULTIPLICATION OF 0050 
» THE RESULTING POLYNOMIALS MAY BE SIMPLIFIED BY THE 0051 

* FOLLOWING CONSIDERATIONS - THE EXPONENTIAL MAY BE 0052 
» REPRESENTED AS A CONTINUED PRODUCT OF POLYNOMIALS 0053 
» WHERE THE ITH POLYNOMIAL IS OF THE FORM 0054 
» 0055 

* L-l 0056 

* P(I) = (SUM( CU»J)»(Z»*m+ 1) *EXP»»( TRANI I) ) 0057 
» 1=1 0058 
» WHERE 0059 

* C(I,J)= (TRAN(1)/1)*(TRAN(2)/2)».....«!TRAN(I)/(J/I)I 0060 
» FOR J=K«I 0061 
» C(I,J)= 0 FOR J NOT =K*I 0062 
» THE C(I,0) TERMS ARE 1 FOR ALL I. 0063 
» 0064 
» WE ARE ONLY INTERESTED IN THE FIRST L TERMS OF THE WAVELET 0065 
» SO WE NEED ONLY CONSIDER TERMS IN THE POLYNOMIALS WITH 0066 

* EXPONENTS LESS THAN OR =M,M=L-1. WE CAN THEN COMPUTE THE 0067 

* WAVELET COEFFICIENTS BY PARTIAL CONVOLUTION OF THE 0068 

* POLYNOMIAL COEFFICIENTS. THAT IS, 0069 

* 0070 

* WAVE(I)= C(l, J)»C(2, J)*...C(M, J) 0071 
» 0072 

* WHERE WAVE(I) IS THE WAVELET, M=L-1» AND THE • SYMBOL 0073 

* DENOTES CONVOLUTION. 0074 
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» IT WILL BE NOTED THAT IF THE CONVOLUTION IS REPRESENTED 0075 

* IN STEPS BY 0076 

* B(M~l)= C( M-l, J)*C(M, J) « B<K)=C!K, J)*B(K*lt 0077 

* BY CAREFUL INSPECTION OF THE FORM OF THE C(I,J) ONE CAN 0078 

* WRITE DOWN THE B(N) BY INSPECTION FOR N=L/2 {ROUNDED DOWN) 0079 
» +1. THIS CUTS DOWN THE TOTAL LABOR BY NEARLY 1/2. 0080 

» B(N)= 1,0,0, ,0,C(N,N),C<N+1,N+1),....,C<M,M) 0081 

» FACTOR SETS UP B( N ) AND THEN USES AN INTERNAL SUBROUTINE 0082 

» TO SET UP C(N-1,J) FOR J=0,M. THE INTERNAL SUBROUTINE 0083 

* PARCON COMPUTES THE PARTIAL CONVOLUTION WHICH IS B<N-i). 0084 

* THE NEXT C(I,J) IS SET UP BY CCOM AND THE NEXT BII-1) 0085 

* COMPUTED BY PARCON. THIS IS REPEATED UNTIL ALL THE PARTIAL 0086 

* CONVOLUTIONS HAVE BEEN DONE. THE RESULTING WAVELET IS THEN 0087 

* SCALED BY £XP»» ( TRANU ) ) . 0088 

* THE OUTPUT OF PARCON FOR ONE STAGE IS THE INPUT FOR THE 0089 

* NEXT STAGE SO THAT THE ADDRESSES Bl AND B2 IN THE PARCON 0090 

* ROUTINE ARE REVERSED BETWEEN STAGES. 0091 

* 0092 

* LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0093 

* EQUIPMENT - 709,7090 (MAIN FRAME ONLY) 0094 

* STORAGE - 308 DECIMAL REGISTERS 0095 

* SPEED - 2200+94L+16L**2+3L*«3+270N+37L*N MACHINE CYCLES 0096 

* AUTHOR - J.N. GALBRAITH NOV. 1, 1961 0097 

* 0098 

* 0099 

* USAGE 0100 

* 0101 

* TRANSFER VECTOR CONTAINS ROUTINES - MAXAB, COSTBL, COSP 0102 

* AND FORTRAN SYSTEM ROUTINES - LOG, EXP 0103 

* 0104 

* FORTRAN USAGE 0105 

* CALL FACTOR(SPECT,N,L, WAVE, SPACE) 0106 
» 0107 

* INPUTS 0108 
» 0109 

* SPECT(I) 1=1, N SPECTRUM FROM ZERO TO PI 0110 

* 0111 

* N NUMBER OF POINTS IN SPECTRUM 0112 
» MUST BE GRTHN 0. 0113 

* 0114 

* L LENGTH OF DESIRED WAVELET. 0115 

* MUST BE GRTHN 0, LSTHN= N. 0116 

* 0117 

* SPACEII) I=1,NSPACE. NSPACE=3*L*N+i . WORK SPACE FOR COMPUTATIONS. 0118 
» THE QUANTITIES B2 ( I > ,C < I ) , TRANU ) , WORK U ) , AND C0ST( I ) 0119 
» WHICH ARE MENTIONED IN THE ABOVE ABSTRACT ARE IN SPACE C I ) 0120 
» IN THE FOLLOWING MANNER— (SEE OUTPUTS FOR LOCATION OF Bl) 0121 
» B2(I) f I«l,L IS SPACE(I) TO SPACE(L). SPACE FOR PARTIAL 0122 
» CONVOLUTION. 0123 
» CQSTU),I = l,L+i IS SPACEU) TO SPACECL+1). SPACE FOR 0124 
» COSINE TABLE FOR COSINE SERIES EXPANSION. 0125 
» C(I), 1=1, L IS SPACEU + 2) TO SPACE(2L+1). SPACE FOR COLUMN 0126 

* OF C( I, J ) MATRIX. 0127 

* W0RKU),I = 1,N IS SPACE(2L+2) TO SPACE ( 2L+N+1). WORK SPACE 0128 

* FOR SPECTRUM. 0129 

* TRANU), 1*1, L IS SPACE ( 2L+N+2 ) TO SPACE ( 3L+N+1) . SPACE 0130 
« FOR COSINE TRANSFORM. 0131 
» 0132 
» NOTE- 0133 

* NO CHECKS ARE MADE ON THE VALUES OF N AND L. BOTH MUST BE GREATER 0134 

* THAN 0, AND L MUST BE LESS THAN OR =N. ILLEGAL VALUES MAY RESULT 0135 
» IN INCORRECT WAVELETS OR PROGRAM LOOPS. 0136 
« 0137 

* OUTPUTS 0138 
« 0139 

* WAVE(I) 1=1, L OUTPUT MINIMUM PHASE WAVELET. SAME SPACE IS USED 0140 
» FOR Bill), 1=1, L. IF THE INPUT SPECTRUM CAN BE DESTROYED, 0141 
» SPECT AND WAVE CAN BE THE SAME. WE NOTE THAT N IS GRTHN 0142 

* OR EQUAL TO L SO THAT THERE IS NO SPACE DIFFICULTY 0143 
» INVOLVED IN THIS EQUIVALENCE. 0144 

* 0145 
» EXAMPLES 0146 

* 0147 

* I. INPUTS - 0148 

* FOR A CONTINUOUS SPECTRUM 0149 
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* SPECT* l.25+COS(W>, W=0,PI 

* THE WAVELET IS 

» WAVE- l.,.5,0.,0., ,0. 

* FOR THE DISCRETE CASE THE NUMBERS WILL NOT COME OUT 

* EXACTLY THE SAME DUE TO ROUND OFF AND APPROXIMATION. 

* FOR A TEST CASE THE INPUT SPECTRUM CAN BE SET UP WITH A 

* FORTRAN LOOP. SPECT ( I )*1 .25 +COSF< FLOATFU-1 1 *WI ,I=*1,N 

* W -PI/FL0ATF(N-1) 

* WHERE N IS THE LENGTH OF THE SPECTRUM. 
» RESULTS ARE GIVEN BELOW FOR N*500 

* 

» OUTPUTS - WAVE<1...5)= I . OOOEOO, 0. 5000E00,-0.4899E-06,-0. 132TE-0T 
• 

* THE HIGHER TERMS ARE EVEN SMALLER WITH WAVE<20) LESS THAN 
» 10**(-8) 

« 

* PROGRAM FOLLOWS BELOW 



0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 



PZE 








0168 


BCI 


1, FACTOR 






0169 


FACTOR SXA 


RETURN, 1 




SAVE IR1 


0170 


SXA 


RETURN+1, 


2 


SAVE IR2 


0171 


SXA 


RETURN+2, 


4 


SAVE IR4 


0172 


SXD 


FACTOR-2, 


4 




0173 


CLA 


1,4 




SPECTRUM ADDRESS 


0174 


STA 


MAX+2 






0175 


ADD 


ONE 






0176 


STA 


LOOPl 






0177 


CLA» 


2,4 




GET N IN DECREMENT 


0178 


STD 


ENDl 






0179 


STO 


N 






0180 


* CALL 


F ACTOR, SPECT, 


N, 


L, WAVE, SPACE) 


0181 


SUB 


DONE 




N-l 


0182 


STO 


NN 






0183 


ADD 


DONE 






0184 


LRS 


18 




N IN ADDRESS 


0185 


STO 


NA 






0186 


SUB 


ONE 






0187 


ORA 


CONST 






0188 


FAD 


CONST 






0189 


STO 


NF 




NF"FLOAT ING (N-l) 


0190 


CLA* 


3,4 




GET L IN DECREMENT 


0191 


STO 


L 






0192 


STD 


END3 






0193 


ARS 


18 




L IN ADDRESS 


0194 


STO 


LA 






0195 


CLA 


4,4 




GET Bl AND WAVELET ADDRESS 


0196 


STA 


WAVAD 






0197 


STA 


PAR+i 






0198 


STA 


BFST 






0199 


STA 


L00P2 






0200 


STA 


L00P3+1 






0201 


STA 


L00P4+2 






0202 


CLA 


5,4 




GET B2 AND COST ADORESS 


0203 


STA 


B2AD 






0204 


STA 


PAR+2 






0205 


STA 


CST+2 






0206 


STA 


CSP+4 






0207 


SUB 


LA 






0208 


SUB 


ONE 




ADDRESS OF C 


0209 


STA 


PAR+3 






0210 


STA 


COM+l 






0211 


SUB 


LA 




ADDRESS OF WORK 


0212 


STA 


WGT+3 






0213 


STA 


WGT+5 






0214 


STA 


CSP + 1 






0215 


STA 


CSP+2 






0216 


ADD 


ONE 




ADDRESS OF WORK+1 


0217 


STA 


END1-2 






0218 


STA 


WGT 






0219 


STA 


WGT+2 






0220 


SUB 


NA 






0221 


SUB 


ONE 




ADDRESS OF TRAN 


0222 


STA 


CSP+9 






0223 


STA 


L00P3 






0224 
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* FACTOR * 



f D AflP A 1 








t DATE 




CTA 


r riM4- o 
*»un*z 




022 5 




STA 


SCALE 




UCc O 


MAX 


1 OA 


tMAVAA.A 


PTMD MAY TMIIM DC CDCTTIIM 
rllNU rlAA InUn Ur jrCU 1 Un 


no? 7 
vec % 






M 




UCCO 




PZE 




LUUAl 1 UIN Ur Or Ci» J Un 






r 4LC 


DTrcn 
Dlujr 




Uc. 3U 




r LC 


r wnpy 

1 IlUt A 




Ut J A 




LOQ 


otrcp 


MAV nc CDPrTIIM 
HAA • Ur Jr cw i un 


Ucjc. 




F MP 


DEC 


in«»i-Ai np mav 

iU**l Ol Ur nAA 


0233 






B I GSP 




0234 




A XT 


A 9 A 




Cl? 

U*. 0 7 


L00P1 


CLA 


• » . 1 

9 w 9 I 




0236 




f AC 


a T CCD 




Ut 3 r 




TRA 


* + 3 


Ore 1 .! LAKt»CK 


02 3 8 




TRA 


*+2 


CDCfT PQMAl 


0239 




CLA 




Or EL. 1 Leo J 


0240 




TSX 




i net cocr t i 

L Uv» l ortl I 1 


U/l'H 




FDP 


NF 


LUU \ OrCUl J / I IN"~ A I 


0242 






•* 9 I 


**=UriOK 4. 1 
**-WU(\Nt A 


U^.*T^> 




TV1 
• M 


• 4-1 - 1 .1 
*▼ 1 9 A 9 I 




0244 


ClNU J. 


Ttfl 
1 AL 


LUUr A 9 1 9 » » 


* # — N 






TXI 


*♦! .1.-1 
" T i|lf A 




0246 


WGT 


CLA 




w * hui\i\ ~ j. • n c x on i lmo i 


0247 




FOP 


T WOD 


TFfJM TNJ ^PPTTRIIM RY 1/7 
I C(\rl A IN ore 1 * ll\Un DT X. 1 C 


0248 




J IW 


*» 9 A 


« »=y note +• i 










*»=ynoK up t cut ciDCT 


H7«* fl 

KJC.J U 




FDP 


TWOD 


TPQM TM ^PPTTDilM RY 1/7 


U£ 7 A 




STQ 


«• 


*»=WORK 






CLA 


L 




0253 




SUB 


DONE 




Uc 7*» 




STO 


LL 




U£77 




TSX 


$C0STBL,4 


GO TO COSINE TABLE 






PZE 


NN 




Vic. j 1 




PZE 


** 


COST 


a 

Uc. 7 o 


* UUor 


GIVES HALF OF COSINE 


TRANSFORM OF LOGCSPECT) EXCEPT FOR 


U£ 3 ^ 




TRANU) 


WHICH IS 2 TIMES NEEDED VALUE • 


ft)/- ft 


U or 


TSX 


$C0SP,4 


GO TO COSINE TRANSFORM 


UcO A 




PZE 


•* 


WORK SPACE FOR SPECTRUM 


UtOt 




PZE 


•« 


WORK SPACE FOR SPECTRUM 






PZE 


NN 


N-l 


ftliA 

u^o*. 




PZE 




COST 


no a*; 




PZE 


NN 


N-l 


H9 A A 




PZE 


ZERO 


JMIN=0 


no a 7 

UZO 1 




PZE 


LL 


JMAX-L-1 


UtOO 




PZE 


ONED 


1.0 


n? aq 




PZE 




TRANtCOSTR) 


0270 


* TRAN 


CONTAINS COSINE TRANSFORM OF 1/2 LOG(SPECT). FIRST TERM 


\Jc. i A 


* MUST 


BE WEIGHTED BY 1/2. 


(SEE SYMBOLIC ADDRESS **SCALE*».) 


0272 




CLA 


L 




0273 




ARS 


1 


L/2 


0274 




ANA 


MASK 




02 75 




ADD 


DONE 


L/2+1 


0276 




STO 


M 


M=L/2*1 


0277 




CLA 


ONED 


1.0 


0278 


Or O 1 


STO 


*• 


***B1. 81(0)^1.0 


U<C f 7 




AXT 


I9I 




0280 




CLA 


M 


M 


028 1 




SUB 


DONE 


M-l 


0282 




STD 


END2 




0283 


L00P2 


STZ 


»» 9 I 


CLEAR Bl 


0284 




TXI 


♦♦1,1,1 




028 5 


END2 


TXL 


♦-2,1 9 *» 




0286 




LXD 


M,l 


IR1=M 


0287 


LUUrJ 


CLA 




TRAN 


0288 




STO 




Bl 


f\0 R Q 




TXI 


•♦lfl.l 




0290 


EN03 


TXL 


LOOP3,l,** 


L IN OECREMENT 


029 1 




AXT 


1,2 




0292 




CLA 


M 




0293 




STO 


P 




0294 




SUB 


DONE 




0295 




STD 


END23 




0296 




AXT 


1,1 




0297 


CONV 


CLA 


P 




0298 




SUB 


DONE 




0299 
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STO 


P 




0300 




SXD 


K,2 




0301 


COM 


TSX 


CCOM, 4 




0302 




PZE 


• * 


C 


0303 




PZE 




TRAN 


0304 


PAR 


TSX 


PARC0N,4 




0305 




PZE 


• * 


LOCATION OF Bl 


0306 




PZE 


«* 


LOCATION OF B2 


0307 




PZE 


** 


LOCATION OF C 


0308 




CLA 


PAR+1 


EXCHANGE 


0309 




LDQ 


PAR+2 


LOCATIONS 


0310 




STO 


PAR+2 


OF Bl 


0311 




STQ 


PAR+1 


AND B2 


0312 




TXI 


•♦1,2,1 




0313 




TXI 


*+i,i,i 




0314 


END23 


TXL 


CONV,l,»» 


**=M-l 


0315 




CLA 


M 


GET M 


0316 




ARS 


18 


M IN ADDRESS 


0317 




LBT 




LOW BIT TEST 


0318 




TRA 


♦ + 4 


M EVEN, B2 CONTAINS WAVELET 


0319 




CLA 


WAVAD 


M ODD, Bl=WAVELET 


0320 




STA 


LOOP* 




0321 




TRA 


• ♦3 




0322 




CLA 


B2AD 


B2 ADDRESS. B2 WAVELET. 


0323 




STA 


L00P4 




0324 


SCALE 


CLA 


*• 


**=TRAN<1> 


0325 




FDP 


TWOD 




0326 




XCA 






0327 




TSX 


$EXP,4 




0328 




STO 


NORM 


SCALE FOR WAVELET 


0329 




CLA 


LL 




0330 




STD 


END4 




0331 




AXT 


0,1 




0332 


LOOP4 


LDQ 


♦ ♦,1 


B2 OR Bl 


0333 




FMP 


NORM 


SCALE FOR WAVELET 


0334 




STO 




WAVELET 


0335 




TXI 


♦+1,1,1 




0336 


END4 


TXL 


L00P4,1,*» 


**=L-1 


0337 


RETURN 


AXT 


♦ ♦,1 


RESTORE IR1 


0338 




AXT 


• ♦,2 


RESTORE IR2 


0339 




AXT 




RESTORE IR4 


0340 




TRA 


6,4 




0341 


L 


PZE 


0 




0342 


LL 


PZE 


0 


L-1 


0343 


K 


PZE 


0 




0344 


N 


PZE 


0 




0345 


NN 


PZE 


0 


N-l 


0346 


M 


PZE 


0 




0347 


P 


PZE 


0 




0348 


NF 


PZE 


0 




0349 


NA 






N IN ADDRESS 


0350 


LA 






L IN ADDRESS 


0351 


WAVAD 






WAVELET AND Bl ADDRESS 


0352 


B2AD 






B2 ADDRESS 


0353 


NORM 


PZE 


0 




0354 


BIGSP 


PZE 


0 




0355 


INDEX 


PZE 


0 




0356 


CONST 


OCT 


+233000000000 


0357 


MASK 


OCT 


777777000000 


0358 


ZERO 


PZE 


0 




0359 


ONE 


PZE 


1,0,0 




0360 


DONE 


PZE 


0,0,1 




0361 


ONED 


DEC 


1.0 




0362 


TWOD 


DEC 


2.0 




0363 


DEC 


DEC 


.000001 




0364 


*CCOM - 


-COMPUTES C<P,J> FOR 


J=0 TO L-1 


0365 


•CALLING SEQUENCE 




0366 


» 


TSX 


CCOM, 4 




0367 


* 


PZE 


LOCATION OF 


C(P,0) 


0368 


* 


PZE 


LOCATION OF 


TRAN 


0369 


• 


RETURN 






0370 


CCOM 


SXA 


BACK, I 


SAVE IR1 


0371 




SXA 


BACK+1,2 


SAVE IR2 


0372 




SXA 


BACK+2,4 


SAVE IR4 


0373 




CLA 


L 


GET L 


0374 
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Anno 




wJ (3 






p 


GET P 


0376 




ARS 


1 A 
AO 


L 1 'N AUUI\C5 5 


A177 




rue 






U3 f O 




a nn 
A w 


1 _ 4 


AUUKCjj Ur llrirl 


0379 




<IT A 
o 1 A 


AUUR J 




U30U 




STA 


ADDR4 




0381 




CLA 


1-4 


i nr at ion of r i n \ 


0382 




STA 


ADDR1 




0383 




ADD 


ONE 




0384 




^TA 


ADDR2 




0385 






p 




0386 




ARS 


1 o 




0387 




ADD 


?_ A. 


T R AN 


0388 




STA 


STO I 




0389 




CLA 


ON ED 


1 • 0 


0390 


A DDR I 


STO 




C ( 0 ) 


0391 




AXT 




CLEAR 


0392 


ADDR2 


j 1 1 


** 1 1 


C ( 1 ) TO 


0393 




T V T 
* A 1 


*♦ 1,1,1 


rill 


0394 




T ¥1 


AUURt fit** 




0395 


STOl 


CLA 




TRAM { P ) 


0396 


ADDR3 


STO 


** 


C ( P, P ) 


0397 




STO 


TEMP 1 




0398 




STO 


TEMP2 




0399 




CLA 


LL 




0400 




LRS 


35 


INTO MQ 


0401 




DVP 


p 


( L— 1 ) /P 


0402 




LLS 


53 


INTO AC 


0403 




SUB 


DONE 


( L— 1 ) / P— 1 


0404 




T ZE 


BACK 


IF 7FHD.Nn MflRF TP! nn 


0405 




STD 


END 


NflT 7FRO. ^FT TD Dfl (1— 11/P— 1 TTMF^ 


0406 






p 




0407 




PDX 




D TM TD9 


0408 




SXD 


C IN U c|4 




0409 




AXT 


1 l 
1 f 1 




041 0 




r i a 

\» L. A 


Turin 
1 nun 


uc I £ • U 


04 1 1 




STO 




TWTTTAI I7F R 
llll 1 1AL 1 i.C is 


041 2 


LOOP 


LDQ 


TEMPI 




04 1 3 




FMP 


TE MP2 


TD AM 1 1 1 
1 r\ A IN I 1 # 


0414 




FDP 






041 5 


ADDR4 








041 6 




o 1 W 


Tp up I 


<iA\/F FflR MFXT C 

JAVC rUK MCA 1 V> 


041 7 




CLA 


f{ 


GET R 


041 8 




FAD 


ON ED 


INTRFMFNT RY 1 O 


041 9 




STO 


R 


RE—SET R 


0420 




TXI 


*+i,2,** 


t» s p. INfRFMFNT C STORAftF TNDFX 


0421 




TXI 


*+l,l,l 


TNTRFMFNT 1 OHP f flllNTFR 


0422 


END 


TXL 


L00P,i,«* 


* * = 1 — 1 / P— 1 FND 1 nnP rHFTK- 


042 3 


BACK 


AXT 




opcTflRF TR1 


0424 




AXT 


**,2 


RF^TflRF TRP 


042 5 




AXT 


**,4 


RF^TORF IR4 


0426 




TRA 


3,4 




0427 


TEMPI 


PZE 


0,0,0 


Will CONTAIN PARTIAI «il]M FOR ffPl 


042 8 


TEMP2 


PZE 


0,0,0 


Will fflNTATN TR-ANIP) 


0429 


R 


PZE 






0430 


♦PARCON COMPUTES A PARTIAL 


rriNvni mtthn rf r ANn ri 


043 1 


•CALLING SEQUENCE 




0432 


* 


TSX 


PARCON, 4 




0433 


• 


PZE 


LOCATION OF 


Bl 


0434 


• 


PZE 


LOCATION OF 


B2 


0435 


» 


PZE 


LOCATION OF 


C ( X , 0 ) 


0436 


PARCON 


SXA 


EXT, I 




0437 




SXA 


EXT+1,2 


SAVF IR? 


0438 




SXA 


EXT+2,4 


SAVE IR4 


0439 




CLA 


2,4 


GET LOCATION OF B2 


0440 




STA 


REGl 




0441 




STA 


REG3 




0442 




STA 


REG3+1 




0443 




ADD 


ONE 




0444 




STA 


REG2 




0445 




CLA 


3,4 


LOCATION OF C 


0446 




STA 


REG5 




0447 




CLA 


ONED 


1.0 


0448 


REGl 


STO 


• » 


B2(0)M.O 


0449 
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AXT 


2*1 




0450 




CLA 


L 


GET L 


0451 




STO 


REG2+2 




0452 




SUB 


DONE 




0453 




STD 


REG8 




0454 


REG2 


STZ 


** » 1 


CLEAR B2(l) TO B2(L) 


0455 




TXI 


*+l»l» 1 




0456 




TXL 


REG2, 1, ** 


DECREMENT«L 


0457 




CLA 


M 




0458 




SUB 


K 


K GOES FROM I TO M-l. SET BY CALLING LOOP. 


0459 




PDX 


,1 


IR1=M-K 


0460 




SXD 


REG3+2,! 




0461 




POC 


*2 




0462 




SXD 


REG3+3,2 




0463 




SXD 


St 1 


S= IR1=M-K 


0464 


REG7 


AXT 


0,2 


ZERO IR2 


0465 




LXA 


EXT+2,4 


RESET IR4 


0466 




CLA 


s 


GET S 


0467 




STD 


REG6 




0468 




CLS 


s 




0469 




ARS 


18 




0470 




ADD 


1,4 


LOCATION OF BKS) 


0471 




STA 


REG4 




0472 




AXT 


0,4 




0473 


REGS 


LDQ 


•♦,4 


C(0) 


0474 


REG4 


FMP 


*«,2 


BKS) 


0475 


REG3 


FAD 


»»,1 


82 


0476 




STO 


»»t 1 


B2 


0477 




TXI 


*+l,4,** 


(M-K) IN DECREMENT 


0478 




TXI 


♦♦1 ,2,** 


~(M-K) IN DECREMENT 


0479 


REG6 


TXL 


REG5,4,*» 


*»»S 


0480 




TXI 


•♦1,1,1 




0481 


REG8 


TXL 


REG7-l,l,»* 


»*=L-1 


0482 


EXT 


AXT 


♦ *,1 


RESTORE IR1 


0483 




AXT 


**,2 


RESTORE IR2 


0484 




AXT 


#*,4 


RESTORE IR4 


0485 




TRA 


4,4 


RETURN 


0486 


S 


PZE 


0 




0487 




END 






0488 



*••*•»»»**•*•»*•••»•*•»* PROGRAM LISTINGS #*****»»•»*»»*•**»♦*«*»» 

* FAPSUM * * FAPSUM » 



FAPSUM (SUBROUTINE) 
FAP 



9/29/64 LAST CARD IN DECK IS NO. 



•FAPSUM 



COUNT 50 
LBL FAPSUM 

ENTRY FAPSUM (LD, DATA, SUMCK ) 

• 

» ABSTRACT 

« TITLE - FAPSUM 

« COMPUTES A LOGICAL SUMCHECK 

« 

* FAPSUM COMPUTES A SUMCHECK BY SUMMING THE CONTENTS OF A 

* VECTOR WITH THE -ADD AND CARRY LOGICAL WORD— INSTRUCTION. 
• 

* LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 

* STORAGE - 14 REGISTERS 

* SPEED - LENGTH OF VECTOR TIMES 4 MACHINE CYCLES 

* AUTHOR - J.F. CLAERBOUT, JUNE, 1962 
* 

* USAGE 

• 

» TRANSFER VECTOR CONTAINS ROUTINES - NONE 

* AND FORTRAN SYSTEM ROUTINES - NONE 
• 

» FORTRAN USAGE 

* CALL FAPSUM( LD»DATA, SUMCK) 
• 

« INPUTS 
» 

« DATA ( I ) 

* LD 

* OUTPUTS 



1 = 1 ... LD IS A DATA VECTOR. 
(NEED NOT HAVE FLOATING NAME). 



IS FORTRAN II INTEGER. 



0065 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 



» 






0037 


* 


SUMCK 


IS LOGICAL SUMCHECK FOR THE DATA. 


0038 


» 




(NEED NOT HAVE FLOATING POINT NAME) 


0039 


* 






0040 


* EXAMPLES 




0041 


• 






0042 


* I. 


INPUTS 


- DATAU...3) = l.,-2.,-3. LD*3 


0043 


• 


OUTPUTS 


- SUMCK = OCT 60660000001 


0044 


» 






0045 


* 2. 


INPUTS 


- DATAU...4) = 1,-2,-3,4 LD=4 


0046 


* 


OUTPUTS 


- SUMCK = OCT 000012000001 


0047 


« 






0048 


» 3. 


INPUTS 


- DATAU...2) = 6HAB , 6H 45 LD»2 


0049 


* 


OUTPUTS 


- SUMCK = OCT 020264664141 


0050 


• 






0051 




BCI 


1, FAPSUM 


0052 


FAPSUM SXA 


SV4,4 


0053 




CLA 


2,4 


0054 




ADD 


= 1 


0055 




STA 


A 


0056 




CLA* 


1,4 


0057 




PDX 


*4 


0058 




CLM 




0059 


A 


ACL 


*»,4 


0060 




TIX 


A, 4,1 


0061 


SV4 


AXT 


**,4 


0062 




SLW* 


3,4 


0063 




TRA 


4,4 


0064 




END 




0065 



**»••••»•»*•»•#•»«•**«** PROGRAM LISTINGS •###*»**»*»»*♦»*♦#♦»•**# 

• FASCN1 * * FASCN1 « 

•••*»»*«*•«**•*»•»•»**•» «***•*«•*»»**•••»»*»••*» 

* FASCN1 (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0198 

* FAP 0001 
•FASCNl 0002 

COUNT 200 0003 

LBL FASCN1 0004 

ENTRY FASCN1 ( VECT, ILO, IHI , VALUE, IF IND, IANS) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 
» TITLE - FASCNl 0009 
» FAST SCAN VECTOR FOR ELEMENT EQUAL OR GREATER THAN GIVEN VALUE 0010 

* 0011 

* FASCNl SCANS A VECTOR RANGE AT HIGH SPEED TO FIND THE 0012 

* FIRST ELEMENT (IF ANY ) EQUAL TO OR GREATER THAN A GIVEN 0013 

* VALUE. VECTOR MAY BE FIXED POINT OR FLOATING POINT. 0014 

* PROGRAM IS MOST EFFICIENT FOR LONG VECTORS. 0015 
» 0016 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0017 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0018 

* STORAGE - 107 REGISTERS 0019 

* SPEED - 100 ♦ 5.2 N MACHINE CYCLES WHERE N * NO. ELEMENTS SCANNED 0020 

* AUTHOR - S.M. SIMPSON JR, JUNE 1962 0021 

* 0022 

* USAGE 0023 

» 0024 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0025 
» AND FORTRAN SYSTEM ROUTINES - NONE 0026 

* 0027 
» FORTRAN USAGE 0028 

* CALL FASCNl(VECT,ILO,IHI,VALUE, IFIND, IANS) 0029 

* 0030 
» INPUTS 0031 
» 0032 

* VECT(I) I=ILO,...,IHI IS THE FORTRAN-TYPE VECTOR TO BE SCANNED 0033 

* VECT(I) MAY BE FIXED POINT OR FLOATING POINT 0034 
» 0035 

* ILO MUST BE GRTHN- 1 0036 

* 0037 
« IHI MUST BE GRTHN* ILO 0038 
« 0039 

* VALUE IS TO BE COMPARED (BY A CAS INSTRUCTION) AGAINST 0040 
» VECTULO, ... f IHI). VALUE SHOULD BE FIXED POINT OR 0041 
» FLOATING POINT MODE ACCORDING TO MODE OF VECT(I). 0042 

* 0043 

* OUTPUTS 0044 

* 0045 

* IFIND IS NOT DISTURBED IF VECT( ILO, . . . ♦ IHI ) ALL LESS THAN VALUE 0046 
» IS FIRST INDEX GRTHN=ILO SUCH THAT VECT( IFIND) 0047 

* GRTHN^ VALUE IF ONE IS FOUND. 0048 

* 0049 

* IANS * 0 MEANS VECT ( ILO, . . . , IH I ) ALL LESS THAN VALUE 0050 
» = 1 MEANS VECT( IFIND) WAS FOUND TO BE GRTHN= VALUE 0051 

* = -2 MEANS ILLEGAL ILO 0052 

* * -3 MEANS ILLEGAL IHI 0053 

* 0054 

* EXAMPLES 0055 

* 0056 

* 1. SHOWING USE ON BOTH FIXED AND FLOATING DATA 0057 

* INPUTS - XU...7) = 9. ,8. ,7. ,6. ,7. ,8. ,9. VAL *8. 0058 

* IXU...7) » 9,8,7,6,7,8,9 I VAL =8 0059 

* USAGE - CALL FASCNl (X,3,7,VAL,IFIND1, I AN SI) 0060 

* CALL FASCNl(IX,3,7,IVAL,IFIND2,IANS2) 0061 
» OUTPUTS - IANS1 » IANS2 * 1 IFIND1 * IFIND2 = 6 0062 

* 0063 

* 2. SHOWING CASE WHEN VALUE NEVER FOUND 0064 
» INPUTS - SAME AS EXAMPLE 1. EXCEPT VAL = 10. 0O65 
» USAGE - CALL FASCNl ( X , 3, 7 , VAL , I F IND, I ANS ) 0066 
» OUTPUTS - IANS = 0 0067 

* 0068 

* 3. ILLEGAL REQUESTS 0069 
» USAGE - CALL FASCNl (X, 0,3, VAL, IFIND, I AN SI) 0070 

* CALL FASCN1(X,5,4»VAL» IFIND, IANS2) 0071 

* OUTPUTS - IANS1 = -2 (ILLEGAL ILO) IANS2 = -3 (ILLEGAL IHI) 0072 

* 0073 
HTR 0 0074 
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* FASCN1 * • FASCN1 ♦ 
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HTR 




0 






0075 




HTR 




0 






0076 




BCI 




I, FASCNI 




0077 


FASCNi 


SXD 




FASCNl-4,1 




0078 




SXD 




FASCNl-3,2 




0079 




SXD 




FASCNl- 


•2,4 




0080 


•SET AODRESSES 








008 1 




LL A 




1 1 4 




A I A I Vfclr 1 J 1 


0082 




AUU 




Kl 




+ 1 


0083 




C T A 




CI 






0084 




C T A 
5 1 A 




C2 






0085 




CTA 

o 1 A 




C3 






0086 




STA 




C4 






0087 




CTA 
O 1 A 




C5 






0088 




CTA 
5 I A 




C6 






0089 




CTA 

5 1 A 




C7 






0090 




STA 




C8 






009 1 




STA 




C9 






0092 




STA 




CiO 






0093 




CLA 




2,4 




A< At ILO) ) 


0094 




STA 




GET2 






0095 




CLA 




3,4 




Ai A( IHI) ) 


0096 




STA 




GET3 






0097 




CLA 




5,4 






0098 




STA 




PUTS 






0099 




CLA 




6,4 






0100 




STA 




PUT6 






0101 


•CHECK 


ILO, 


IHI AND MAKE SETTINGS 


0102 




CLS 




K2 






0103 




STO 




IANS 






0104 


GET2 


CLA 




*♦ 




A( ILO) 


0105 




STO 




ILO 






0106 




TMI 




LEAVE 






0107 




TZE 




LEAVE 






0108 


• (SET 


TO COUNT 


ON XRl 


FROM 


ILO TO IHI) 


0109 




PDX 




0,1 






0110 




CLS 




K3 






0111 




STO 




IANS 






0112 


GET3 


CLA 




*• 




AC IHI) 


0113 




CAS 




ILO 






0114 




NOP 










0115 




TRA 




IHIOK 






0116 




TRA 




LEAVE 






0117 


IHIOK 


STD 




GOBAK 






0118 




STD 




MAYBE 






0119 


• MAKE 


TRIAL 


SETTING OF 


IANS 


=0 


0120 




STZ 




IANS 






0121 


•PUT VALUE 


IN 


AC 






0122 




CLA 




4,4 




A( A( VALUE ) ) 


0123 




STA 




GET4 






0124 


GET4 


CLA 




*# 




A ( VALUE ) 


0125 


♦COMPARE IN 


BLOCKS OF 


LENGTH 10 


0126 


CI 


CAS 




«*, I 




A(VECT)+1 


0127 




TXI 




C2,l,l 






0128 




NOP 










0129 




TRA 




MAYBE 






0130 


C2 


CAS 




•♦,1 




DITTO 


0131 




TXI 




C3,l,l 






01 32 




NOP 










0133 




TRA 




MAYBE 






0 1 34 


C3 


CAS 




♦ ♦,1 




DITTO 


0135 




TXI 




C4,l,l 






0136 




NOP 










0137 




TRA 




MAYBE 






0138 


C4 


CAS 




• •,1 




DITTO 


0139 




TXI 




C5,l,l 






0140 




NOP 










0141 




TRA 




MAYBE 






0142 


C5 


CAS 




**, 1 




DITTO 


0143 




TXI 




C6,l,l 






0144 




NOP 










0145 




TRA 




MAYBE 






0146 


C6 


CAS 




•♦,1 




DITTO 


0147 




TXI 




C7,l,L 






0148 




NOP 










0149 



FASCN1 
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C7 



C8 



C9 



CIO 





» 


TRA 


MAYBE 


CAS 


**t 1 


TXI 


C8 , 1 , 1 


NOP 




TRA 


MAYBE 


CAS 


«»» 1 


TXI 


C9» 1, I 


NOP 




TRA 


MAYBE 


CAS 


**# I 


TXI 


CIO, It I 


NOP 




TRA 


MAYBE 


CAS 


♦♦,1 


TXI 


GOBAK,l,l 


NOP 




TRA 


MAYBE 



PROGRAM LISTINGS 



FASCNl 



DITTO 



DITTO 



DITTO 



DITTO 



♦GO BACK AND COMPARE NEXT 10 ELEMENTS 
•IF WE HAVENT RUN OFF END 

GOBAK TXL Cl t lt*« ♦♦=IHI 

•NONE FOUND IF WE INDEXED OFF ENO 

TRA LEAVE 
•IN CASE OF JUMP FROM LOOP TO MAYBE, ELEMENT IN IV 
♦HAS BEEN FOUND=OR GREATER THAN VALUE, PROVIDED 
♦ THAT WE HAVE NOT INDEXED BEYOND VECTUHI) 

MAYBE TXL FIND,1,^» ♦•=IHI 

TRA LEAVE 
•ELEMENT DEFINITELY FOUND=OR GREATER THAN LEVEL 
•SET IFIND, I ANS, AND EXIT 



< PAGE 

0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 



FIND PXD 


0,1 




0179 


PUT5 STO 


• » 


A< IFIND) 


0180 


CLA 


Kl 




0181 


STO 


IANS 




0182 


♦ LEAVE »STORI NG 


IANS 




0183 


LEAVE CLA 


IANS 




0184 


ALS 


18 




0185 


PUT6 STO 


** 


A( IANS) 


0186 


LXD 


FASCNl-4,1 




0187 


LXD 


FASCNl-3,2 




0188 


LXD 


FASCNl-2,4 




0189 


TRA 


7,4 




0190 


♦CONSTANTS 






0191 


Kl PZE 


1 




0192 


K2 PZE 


2 




0193 


K3 PZF 


3 




0194 


♦VARIABLES 






0195 


I ANS PZE 


** 


-2,-3,0,1 


0196 


ILO PZE 


0,0, •* 




0197 


END 






0198 



**«•**•*•••**»«#•***•«•» PROGRAM 
* FASCOR * 
•**•**•••*••»«****•«**«* 

REFER TO 

PROCOR 



LI STINGS ###*##*#»#***♦#**##«##«* 
* FASCOR * 
«•*#**•«**••*#«»**«*»**» 

REFER TO 

PROCOR 



*••»**•«•»•***»»*«*••*** 

* FASCRl * 



REFER TO 

PROCOR 



#«**««*****»*»«»«#***«*« 
* FASCRl * 
-#»***•»••***##«•«*«****« 

REFER TO 

PROCOR 



»*»•••*«»»•*•»*»»•»* PROGRAM LISTINGS #*#*#»####*. 

FASCUB » * FASCUB 



FASCUB (SUBROUTINE) 
FAP 



9/4/64 LAST CARD IN DECK IS NO. 



•FASCUB 



COUNT 250 
LBL FASCUB 

ENTRY FASCUB (COEFS, XLO, DELX, NF, FOFX ) 



» ABSTRACT 

• 

* TITLE - FASCUB 

* FAST EVALUATE CUBIC FOR EVENLY SPACED ARGUMENTS 
• 

» FASCUB PRODUCES N EVENLY SPACED VALUES OF THE THIRD 

* ORDER POLYNOMIAL 

» 2 3 

* F(X) = A +AX+AX + A X * 

* 0 12 3 

* X = XLO, XLO+DELX, XLO+ ( N-l ) DELX, BY HIGH-SPEED 

» ITERATIVE TECHNIQUES, WHERE XLO AND DELX ARE PARAMETERS. 



LANGUAGE 
EQUIPMENT 
STORAGE 
SPEED 



AUTHOR 



- FAP SUBROUTINE (FORTRAN-II COMPATIBLE) 

- 709 OR 7090 (MAIN FRAME ONLY) 

- 141 REGISTERS 

- Kl + K2 + 27.2»N MACHINE CYCLES 
WHERE 

Kl » 120 M.C. IF DELX=1.0 250 M.C. OTHERWISE 

K2 * 10 M.C. IF XLO =0.0 140 M.C. OTHERWISE 

- S.M.SIMPSON, MARCH 1964 



USAGE 



TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 
AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 



* FORTRAN USAGE 

* CALL FASCUB(COEFS, XLO, DELX, NF, FOFX) 



INPUTS 



COEFS(I) 1=1,2,3,4 CONTAIN A0,A1,A2,A3, RESPECTIVELY, THE 
COEFFICIENTS OF F(X) IN THE ABSTRACT. 



* XLO 
* 

* DELX 
* 

* NF 
* 

» 

* OUTPUTS 

» FOFX(I) 

» 

* 

» 

» EXAMPLES 
• 

* 1. INPUTS 

* USAGE 

* OUTPUTS 
» 

* 2. INPUTS 

* USAGE 

* OUTPUTS 
* 

» 3. INPUTS 

* USAGE 



IS FIRST VALUE OF ARGUMENT OF F(X) IN THE ABSTRACT. 

IS ARGUMENT INCREMENT. SHOULD BE NON-ZERO. 

IS NUMBER OF SUCCESSIVE EVALUATIONS OF FIX) DESIRED* 
MUST EXCEED ZERO. 

STRAIGHT RETURN WITH NO OUTPUT IF NF ILLEGAL. 

1*1,... ,NF CONTAIN THE N VALUES OF F(X) AS DESCRIBED IN 
THE ABSTRACT. 



C0EFS(1...4)=1.0,2.0,-1.0, 3.0 

CALL FASCUB(COEFS,0.0,2.0,4,FOFX1) 
FOFXK 1... 4) = 1.0, 25.0, 185.0,625.0 

COEFS( 1... 4) =0.0, 3. 0,1.0,-4.0 

CALL FASCUB(C0EFS,-2.0, 1.0,3,FOFX2) 
F0FX2(1...3) = 30.0,2.0,0.0 

SAME AS EXAMPLE 2., EXCEPT F0FX5U...4) = -99. 
CALL FASCUB(C0EFS, 1.0, -1.0,2, F0FX3) 
CALL FASCUB(C0EFS, -2. 0,-1.0, 1,F0FX4) 
CALL FASCUB(COEFS,-2.0,-1.0,0,FOFX5) 



0259 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 



* FASCUB 



PROGRAM LISTINGS 



***»»***•****•»»»•*»•»•* 

* FASCUB * 



( PAGE 2) (PAGE 2) 



• OUTPUTS - 


• F0FX3U.. 


• 2 ) 


* 0.0,0.0 




0075 


• 




F0FX4U) 




- 30. 0 




0076 


• 




F0FX5U.. 


.4) 


= -99. 




0077 


* 












0078 


* 












0079 


* PROGRAM FOLLOWS BELOW 








0080 


* 












008 1 


• NO TRANSFER 


VECTOR 








0082 


• 












0083 




HTR 


0 




XR1 




0084 




HTR 


0 




XR4 




0085 




BC I 


1, FASCUB 








0086 


* 












0087 


* ONLY 


ENTRY. 


FASCUB(COEFS 


, XLO, DELX, NF, rUFX J 




0088 


# 












008 9 


FASCUB 


SXD 


F ASLUd— 2 , 


4 






0090 




SXD 


FASCUB— 3 , 


1 


IXR1 COUNTS UUTPUIb) 




0091 




CLA 


It 4 




A ( COEFS 1 




0092 




STA 


CLACO 








0093 




AXT 


3,1 








0094 


CLACO 


CLA 


**,1 




***A ( COEFS i 


LOOP TO GET 


0095 




STO 


Al + 1, 1 






Al , A2, A3 


0096 




TIX 


CLACO, 1,1 




l ufiTr vnt TC i rrT — 

(NOTE XK1 15 LfcrT = 


1 ) 


0097 




CLA* 


4,4 




NF 




0098 




TMI 


LEAVE 








0099 




TZE 


LEAVE 








0100 




STD 


CKF2 








0101 




STD 


CKF3 








0102 




STD 


TXL 








0103 




CLA 


5,4 




A ( FOFX i 




0104 




ADD 


Kl 








0105 




STA 


STOF 








0106 




ADD 


Kl 








0107 




STA 


FADF 








0108 




CLA* 


2,4 




XLO 




0109 




STO 


XLO 








0110 




CLA* 


3,4 




DELX 




0111 




STO 


DELX 








0112 




CAS 


Kl L 




IS IT * 1.0 




01 1 3 




TRA 


NOT1 








0114 




TRA 


DELI 








0115 




TRA 


NOT! 








0116 


* 












0117 


* HI-SPEED SETTING OF CONSTANTS IF DELX=1.0 




UllO 


* 












0119 


DELI 


CLA 


Al 




IT IS ONE, HI-SPEED 




U I C\J 




FAD 


A2 








0121 




FAD 


A3 








0122 




STO 


BZ 




BZ=A1+A2+A3 




0123 




LDQ 


A3 








0 1 24 




FMP 


K3L 








0125 




STO 


B2 




B2*3*A3 




0126 




FAD 


A2 








U l c. % 




FAD 


A2 








0128 




STO 


Bl 




Bi=2*A2+3*A3 








FAD 


B2 








0130 




STO 


CZ 




CZ=B1+B2 




0131 




CLA 


B2 








0 1 32 




FAD 


B2 








U 1 j J 




STO 


CI 




Ci=2*B2 




0134 




STO 


DZ 




DZ=C1 




0135 




TRA 


CKXLO 








Ul JO 


* 












Ul 3 ( 


* SLOWER CONSTANT SETTINGS 


IN GENERAL 






* 












0139 


NOT! 


LDQ 


A3 








0140 




FMP 


DELX 








0141 




FAD 


A2 








0142 




XCA 










0143 




FMP 


DELX 








0144 




FAD 


Al 








0145 




XCA 










C146 




FMP 


DELX 








0147 




STO 


BZ 




BZ*J*(A1+J{ A2+J*A3)) 




0148 




CLA 


DELX 








0149 



FASCUB 
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PROGRAM LISTINGS 



FASCUB 



(PAGE 3) 





FAD 


DELX 






0150 




STO 


TWODEL 






0151 




FAD 


DELX 






0152 




XCA 








0153 




FMP 


A3 






0154 




STO 


B2 




B2=3*A3*J 


0155 




FAD 


A2 






0156 




FAD 


A2 






0157 




XCA 








0158 




FMP 


DELX 






0159 




STO 


Bl 




B1*2*A2»J+3*A3*J*J 


0160 




LDO 


B2 






0161 




FMP 


DELX 






0162 




FAD 


Bl 






0163 




XCA 








0164 




FMP 


DELX 






0165 




STO 


CZ 




CZ 


0166 




LDQ 


B2 






0167 




FMP 


TWODEL 






0168 




STO 


CI 




CI 


0169 




LDQ 


CI 






0170 




FMP 


DELX 






0171 




STO 


DZ 




DZ 


0172 


• 










0173 


• CHECK XLO AND SET Fi 


IN 


THE CASE XLO=0. 


0174 


• (IN 


THIS CASE HI AND 


Gl 


ARE ALREADY OK BY SYNONYMS) 


0175 


* 










0176 


CKXLO 


ZET 


XLO 






0177 




TRA 


GENXL 






0178 




CLA» 


lt4 




COEFS( l)=AZ 


0179 




STO* 


STOF 






0180 




TRA 


TXI I 






0181 


• 










0182 


• SET 


F1,G1,H1 


IN GENERAL 




0183 


* 










0184 


GENXL 


LDQ 


A3 






0185 




FMP 


XLO 






0186 




FAD 


A2 






0187 




XCA 








0188 




FMP 


XLO 






0189 




FAD 


Al 






0190 




XCA 








0191 




FMP 


XLO 






0192 




FAD* 


It* 




COEFSl 1 )-AZ 


0193 




STO* 


STOF 




Fl=AZ+XLO( Al+XLO( A2+XLO»A3) ) 


0194 




LDQ 


B2 






0195 




FMP 


XLO 






0196 




FAD 


Bl 






0197 




XCA 








0198 




FMP 


XLO 






0199 




FAD 


BZ 






0200 




STO 


G 




Gl STORED 


0201 




LDQ 


CI 






0202 




FMP 


XLO 






0203 




FAD 


CZ 






0204 




STO 


H 




HI STORED 


0205 


• 










0206 


• SET 


F0FX(2) 


IF NF GRTHN 


1 


0207 


• 










0208 


TXI1 


TXI 


♦+1,1,1 






0209 


CKF2 


TXH 


LEAVE, 1, 


** 


**=NF 


0210 




CLA 


G 






0211 




FAD* 


FADF 




(XR1 « 2 NOW) 


0212 




STO* 


STOF 






0213 




TXI 


•♦1,1, i 






0214 


CKF3 


TXH 


LEAVE, 1, 


»* 


**=NF 


0215 


• 










0216 


* ENTER LOOP SO AS TO COMPUTE G2 FROM HI, 


0217 


« THEN 


F3 FROM 


G2, THEN 


CYCLE (H2,G3,F4), (H3,G4,F5), ... 


0218 


* 










0219 




CLA 


H 






0220 




TRA 


FADG 






0221 



* LOOP TO PRODUCE F0FX(3,4,. 



,,NF) 



0222 
0223 
0224 



•*»»•••••••••»•***•••••• PROGRAM LISTINGS #»»*#»*#»**•*#*♦*»»*•♦•» 

* FASCUB * * FASCUB * 

•*•••••••»»»•»•*•*•*••*» #»»*♦*»***•***»*»»»»»♦*» 
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CLADZ 


CLA 


DZ 




0225 




FAD 


H 




0226 




STO 


H 




0227 


FADG 


FAD 


G 




0228 




STO 


G 




0229 


FADF 


FAD 


**,1 


**=A( FOFX )+2 


0230 


STOF 


STO 


**,1 


**=A(FOFX)*-l 


0231 




TXI 


♦+1,1,1 




0232 


TXL 


TXL 


CLADZ,!,** 


**«NF 


0233 


» 








0234 


* EXIT 








0235 


• 








0236 


LEAVE 


LXD 


FASCUB-3,1 




0237 




TRA 


6,4 




0238 


*. 








0239 


* CONSTANTS, 


TEMPORARIES 




0240 


* 








0241 


Kl 


PZE 


1 




0242 


K1L 


DEC 


1.0 




0243 


K3L 


DEC 


3.0 




0244 


XLO 


PZE 


• * , #*, »» 




0245 


TWODEL 


PZE 


• * 9 »* , ** 


2*DELX 


0246 


DELX 


PZE 


**,*•, ** 


CALLED J IN EQUATIONS BELOW 


0247 


DZ 


PZE 


#♦ , *• , •* 


J*C1 


0248 


CI 


PZE 


*• y •» v *» 


?*J*B2 


0249 


CZ 


PZE 


**,*»,** 


J*{B1+J*B2) 


0250 


H 


SYN 


CZ 




0251 


B2 


PZE 


*•,**, ** 


3*J*A3 


0252 


Bl 


PZE 


»»,»», •* 


J*(2*A2*3*J*A3> 


0253 


BZ 


PZE 


*» ,»*,»* 


J*(A1+J*( A2+J*A3> ) 


0254 


G 


SYN 


BZ 




0255 


A3 


PZE 


**,**, *» 




0256 


A2 


PZE 


** v ** 9 ** 




0257 


Al 


PZE 


•*,**, #• 




0258 




END 






0259 



* FASEPC ■ 
••»*******«****•***•»«*« 



PROGRAM LISTINGS 



REFER TO 

PROCOR 



#•*«*»«*#**•*#»***»»**•* 
* FASEPC * 
*«•**••«•»«»*•»»**•***«» 

REFER TO 

PROCOR 



•*•••»«••*********•»**•• 

* FASEP1 * 
**•*•**»*»*•***»»*«•***• 

REFER TO 

PROCOR 



#**#»**««*•*««*»**»»»»#* 

* FASEP1 * 
#»*****«*#•**•**»*•**•*• 

REFER TO 

PROCOR 



»*•****•*•**»*••«••**•*» PROGRAM LISTINGS #»»##*«»•*#*»»♦»»#**•»»» 

» FASTRK • • FASTRK • 

*•••»•*••***»**•*»•*#*** **•#**#*•*»»«••••*»••••• 



FASTRK (SUBROUTINE) 
FAP 



9/8/64 LAST CARD IN DECK IS NO. 



•FASTRK 



COUNT 100 
L8L FASTRK 

ENTRY FASTRK ( I XVEC , IXSTRT, I XLOOK, MXTRAK, I ANS) 



» ABSTRACT 

• 

* TITLE - FASTRK 

» FAST TRACK THROUGH A VECTOR OF INDICES 

• 

» FASTRK TRACKS THROUGH A FORTRAN FIXEO POINT VECTOR EACH 

* OF WHOSE ELEMENTS REPRESENTS THE INDEX OF ANOTHER ELEMENT 

* OR ELSE HAS VALUE ZERO, SEARCHING FOR A GIVEN INDEX 

» AND STARTING FROM A GIVEN ELEMENT, SUBJECT TO A LIMIT 

» ON THE NO. OF SEARCHES, AND WHERE SEARCHING STOPS WHEN 

* A ZERO ELEMENT IS FOUND. 
• 

» THUS FASTRK LOOKS DOWNSTREAM IN A BRANCHING PROCESS LIKE 

* A RIVER COMPLEX TO SEE IF RIVER A FLOWS INTO RIVER B. 



LANGUAGE 
EQUIPMENT 
STORAGE 
SPEED 

AUTHOR 



FAP SUBROUTINE (FORTRAN II COMPATIBLE) 
709 OR 7090 (MAIN FRAME ONLY) 
26 REGISTERS 

38 ♦ 12»(N-1) MACHINE CYCLES 

WHERE N ^ NO. OF SEARCHES MADE 
S.M. SIMPSON, JULY 1963 



USAGE 



* TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 
» AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 
• 

» FORTRAN USAGE 

* CALL FASTRK ( I XVEC, I XSTRT , I XLOOK , MXTRAK, I ANS) 



» INPUTS 
» 

» IXVEC(I) 

* 

» 

» IXSTRT 
» 

• I XLOOK 

» MXTRAK 
* 

• OUTPUTS 

• I ANS 



EXAMPLES 



1=1,2,... IS INDEX VECTOR OF ARBITRARY LENGTH. 
ELEMENT MUST BE GREATER THAN OR * ZERO 

SPECIFIES THAT IXVEC( IXSTRT ) IS THE FIRST ELEMENT 

TO BE COMPARED AGAINST IXLOOK 
MUST EXCEED ZERO 

IS THE INDEX SEARCHED FOR 
MUST EXCEED ZERO 



EACH 



IS THE MAXIMUM NO. 
MUST EXCEED ZERO 



OF TRIES TO BE MADE 



(NO LEGALITY CHECKS ARE MADE ON THE INPUTS) 



= 0 
* -1 



MEANS TRAIL STOPPED AT A ZERO ELEMENT 

MEANS TRAIL STOPPED BECAUSE MAX NO. OF TRIES 

WAS ABOUT TO BE EXCEEDED 
WHERE K POSITIVE, MEANS SEARCH WAS SUCCESSFUL, 

AND THAT IXVEC(K) « IXLOOK. 



1. INPUTS 
USAGE 



- IXVECU...12) = 



9, 



5, 4 f 3, 6, 8, 3, 1,12, 4 



CALL FASTRK ( IXVEC,10» 3,10,IANS1) 
CALL FASTRK( IXVEC, 10, 3, 4,IANS2) 
CALL FASTRM IXVEC, 10, 3, 3,IANS3) 
CALL FASTRM IXVEC, 8, 8,10,IANS4) 
CALL FASTRM IXVEC, 4, 4,10,IANS5) 
CALL FASTRM IXVEC, 12, 3,10»IANS6) 
CALL FASTRM IXVEC, 7, 12, 10, IANS7 ) 



0118 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 



**•»»•«•••»*«••»•*«»«»«• PROGRAM LISTINGS #»»*****♦*# 

* FASTRK * * FASTRK 



(PAGE 2) (PAGE 2) 

* CAUL FASTRK( IXVEC 3, 12, 10, I ANS8 ) 0075 

* CALL FASTRM IXVEC, 2, 9,10,IANS9) 0076 

* OUTPUTS - I ANSI = 6 I IE IXVEC(6) * 3) 0077 

* IANS2 * 6 0078 

* IANS3 *-l ( TOO MANY TRACKS. TAKES 4 TO GO FROM 10 TO 6) 0079 

* IANS4 » 8 0080 

* IANS5 = 5 0081 

* IANS6 *-l (NOTE LOOP AT 4-5-4-5 ETC) 0082 

* IANS7 » 0 (STOPS AT IXVEC(3)> 0083 

* IANS8 * 0 DITTO 0084 

* IANS9 » 2 0085 

* 0086 

* 0087 
» PROGRAM FOLLOWS BELOW 0088 

* 0089 
HTR 0 XR4 0090 
BCI 1, FASTRK 0091 

FASTRK SXD FASTRK-2,4 0092 

SXA LEAVE » 2 0093 

SXA LEAVE+1,1 0094 

CLA 1,4 0095 

ADD *-i A( IXVEC )+l 0096 

STA CLA 0097 

CLA* 4 t 4 SET FOR MAX NO. 0098 

POX 0,2 OF LOOKS 0099 

CLA* 2,4 SET TO LOOK AT IXVECC IXSTRT) FIRST 0100 

* BEGIN TRACKING LOOP 0101 
NEXT POX 0,1 0102 
CLA CLA **,1 **=A( IXVEU+l 0103 

TZE SETANS 0104 

CAS* 3,4 0105 

TRA *+2 0106 

TRA ARRIVE 0107 

TIX NEXT, 2, I 0108 

* SET IANS AND LEAVE 0109 
ENOUGH CLS KOI 0110 

TRA SETANS 0111 

ARRIVE PXD 0,1 0112 

SETANS STO* 5,4 0113 

LEAVE AXT **,2 0114 

AXT **,1 0115 

TRA 6,4 0116 

KD1 PZE 0,0,1 0117 

END 0118 



•#•»••••*•»»•••••••* PROGRAM LISTINGS *»•#•»*•♦•*»»••*»»*»*»*» 

FDOT » * FOOT • 

»•••••«•*»*»•*••*»•• «*»^ *»*•*• •*•»•»• 



* FOOT (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO. OlOO 

* FAP 0001 
•FDOT 0002 

COUNT 80 0003 

LBL FOOT 0004 

ENTRY FDOT (LXY,X,Y, ANS) 0005 

ENTRY FDOTR <LXY,X, Y, ANS ) 0006 

* 0007 
» ABSTRACT 0008 

* 0009 
« TITLE ~ FDOT * WITH SECONDARY ENTRY POINT FDOTR 0010 

* FAST DOT PRODUCT OF TWO VECTORS 0011 

* 0012 

* FDOT COMPUTES THE DOT PRODUCT OF TWO VECTORS. 0013 

* 0014 
» FDOTR COMPUTES THE DOT PRODUCT OF A VECTOR WITH THE 0015 

* REVERSE OF ANOTHER VECTOR. 0016 
» 0017 

* THUS FDOT CORRESPONDS TO ONE LAG OF A CROSSCORRELAT ION* 0018 

* FDOTR TO ONE LAG OF A CONVOLUTION. 0019 

* 0020 
» LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0021 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY ) 0022 

* STORAGE - 40 REGISTERS 0023 

* SPEED - LENGTH OF VECTOR TIMES 25.4 MACHINE CYCLES - 7090 0024 

* 28.6 MACHINE CYCLES - 709 0025 
« AUTHOR - R.A. WIGGINS, 4/10/62 0026 

* 0027 

* USAGE 0028 

» 0029 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0030 

* AND FORTRAN SYSTEM ROUTINES - NONE 0031 

* 0032 

* FORTRAN USAGE 0033 
» CALL FDOT (LXY,X,Y, ANS ) 0034 

* CALL FDOTR (LXY,X,Y, ANS) 0035 
» 0036 

* INPUTS 0037 

* 0038 
» X(I) 1=1. ..LXY IS FLOATING POINT VECTOR 0039 
» 0040 

* Yd) ..LXY IS FLOATING POINT VECTOR 0041 
» 0042 

* LXY IS FORTRAN II INTEGER 0043 

* MUST BE GRTHN=1 0044 

* 0045 

* OUTPUTS 0046 

* 0047 
» ANS IS FLOATING POINT DOT PRODUCT OF X AND Y. 0048 
» 0049 

* EXAMPLES 0050 

* 0051 

* 1. INPUTS - X(1...3)=l.,2.,3. Y(l...3)=l.,2.,3. LXY*3 0052 
» OUTPUTS - FDOT ANS=14. FDOTR ANS^IO. 0053 

* 0054 
« 2. INPUTS - X(l)=l. Y(l)=2. LXY=1 0055 

* OUTPUTS - FDOT ANS=2. FDOTR ANS-2. 0056 

* 0057 

* 0058 
» PROGRAM FOLLOWS BELOW 0059 

* 0060 





PZE 








0061 




BCI 


1,FD0T 






0062 


FDOT 


SXD 


•-2,4 


SAVE 




0063 




SXA 


RET, I 


INDECES. 




0064 




CLA* 


1*4 


A(LXY) 




0065 




PDX 


* 1 


SET IR 1 FOR 


FDOT. 


0066 




CLA 


TIX 


SET FDOT 




0067 




STP 


SW 


SWITCH. 




0068 




TRA 


A 






0069 


FDOTR 


SXD 


FDOT-2,4 


SAVE 




0070 




SXA 


RET ,1 


INDECES. 




0071 




A XT 


1*1 


SET IR 1 FOR 


FDOTR. 


0072 




CLA 


TXI 


SET FDOTR 




0073 




STP 


SW 


SWITCH. 




0074 



FOOT 



PROGRAM LISTINGS 



FDOT 
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A 


CAL 


2,4 


A( A(X ) ) 


0075 




ADO 


= 1B35 




0076 




STA 


X 




0077 




CAL 


3,4 


A{ A( Y ) ) 


0078 




ADD 


= 1835 




0079 




STA 


Y 




0080 




STZ 


ANS 




008 i 




CLA« 


1,4 


A( LXY) 


0082 




TZE 


RET-2 




0083 




TMI 


RET-2 




0084 




PDX 


f 4 


SET IR 4. 


0085 


X 


LDQ 


»*, i 


A( X) 


0086 


Y 


FMP 


**,4 


A< Y ) 


0087 




FAD 


ANS 




0088 




STO 


ANS 




0089 


SW 


PZE 


♦♦1,1,1 


EITHER TXI OR TIX **-l,l,i 


0090 




TIX 


X,4,l 




0091 




LXD 


FD0T~2,4 


RESET IR4. 


0092 




CLA 


ANS 




0093 




STO* 


4,4 


A( ANS) 


0094 


RET 


AXT 


•♦•1 


RESET IR 1« 


0095 




TRA 


5,4 


RETURN. 


0096 


TIX 


TIX 


0,,0 




0097 


TXI 


TXI 


0,,0 




0098 


ANS 


PZE 






0099 




END 






0100 
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» FIRE 2 (SUBROUTINE) ' 9/8/64 LAST CARD IN DECK IS NO. 0151 

* LABEL 0001 

CFIRE2 0002 
SUBROUTINE FIRE2 (NRA, NCAT, NCAN, AA, NRR,NCR,RR,NRG,GG,FF, C) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - FIRE2 0007 

C TWO-DIMENSIONAL FILTER BY RECURSION 0008 

C 0009 

C FIRE2 INCREASES THE LENGTH OF ONE DIMENSION OF A 2- 0010 

C DIMENSIONAL LEAST-SQUARE FILTER BY ONE. THUS, GIVEN 0011 

C THE FILTER F(I,J) I=1,...,NRA J=l, ... »NCAN-1 THAT IS THE 0012 

C SOLUTION TO THE EQUATION 0013 

C 0014 

C NRA NCAN-1 0015 

C SUM ( SUM < F( I,J)»R( I-K, J+L-2) ) ) * G<K,L) 0016 

C 1*1 J=l 0017 

C 0018 

C FOR K = 1,...,NRA 0019 

C L = i,...,NCAN-l 0020 

C 0021 

C THEN FIRE2 INCREASES THE J DIMENSION BY ONE SO THAT 0022 

C THE EQUATIONS ARE SATISFIED FOR L = 1,...,NCAN. 0023 

C 0024 

C TO PERFORM THE RECURSION, FIRE2 MAKES USE OF THE 0025 

C PREDICTION ERROR OPERATORS AA AND THE ERROR MATRIX STORED 0026 

C IN COMPUTATION SPACE C AS GIVEN BY RLSPR2. 0027 

C 0028 

C LANGUAGE - FORTRAN II SUBROUTINE 0029 

C EQUIPMENT - 709, 7090, 7094 (MAIN FRAME ONLY) 0030 

C STORAGE - 271 REGISTERS 0031 

C SPEED - ABOUT . 00075*M»N»*2 SECONDS ON THE 7094 MOD 1 0032 

C FOR l\ GRTHN 7 AND M GRTHN 25 . 0033 

C AUTHOR - R.A. WIGGINS 8/63 GEOSCIENCE, INC. 0034 

C 0035 

C USAGE 0036 

C 0037 

C TRANSFER VECTOR CONTAINS ROUTINES - D0TJ,D0TP, I XCARG,MATML3, STZ 0038 

C AND FORTRAN SYSTEM ROUTINES - NONE 0039 

C 0040 

C FORTRAN USAGE 0041 

C CALL FIRE2 ( NRA , NCAT , NCAN, AA, NRR, NCR, RR, NRG, GG, FF, C ) 0042 

C 0043 

C INPUTS 0044 

C 0045 

C NRA NUMBER ROWS IN AA AND F. 0046 

C MUST 8E GRTHN= 1 0047 

C 0048 

C NCAT NUMBER OF COLUMNS OF AA AND F TOTAL. I.E. THIS IS THE 0049 

C UPPER LIMIT ON THE NUMBER OF COLUMNS TO WHICH F CAN 0050 

C BE EXTENDED. 0051 

C MUST BE GRTHN 35 1 0052 

C 0053 

C NCAN NUMBER OF COLUMNS OF AA AND F NOW. I.E. THIS IS THE 0054 

C PRESENT LENGTH OF THE PREDICTORS, THE FUTURE LENGTH OF 0055 

C THE FILTER. 0056 

C MUST BE GRTHN 3 * 0 LSTHN* NCAT 0057 

C 0058 

C AA ( L) L=1,...,NRA*NCAT*NRA CONTAINS THE PREDICTION ERROR 0059 

C OPERATORS A(I,J,K) OF LENGTH NCAN AS GIVEN BY RLSPR2. 0060 

C 0061 

C NRR NUMBER ROWS OF R. 0062 

C MUST BE GRTHN- 1 AND ODD. 0063 

C 0064 

C NCR NUMBER COLUMNS OF R. 0065 

C MUST BE GRTHN= 1 0066 

C 0067 

C RR ( I ) I~ I , • • • , NRR»NCR CONTAINS R(J,K) J=-NRR/2, . . . I • 0, 1 , . . . 0068 

C NRR/2 K=0,...,NCR-i, AN AUTOCORRELATION ARRAY. 0069 

C 0070 

C NRG NUMBER ROWS OF G. 0071 

C MUST BE GRTHN= 1 0072 

C 0073 

C GGU) I=1,...,NRG CONTAINS G( K, L ) K=-NRG/2, . . . , NRG/2 L-NCAN. 0074 
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C IS ASSUMED TO BE ZERO OUTSIDE THE LIMITS OF DEFINITION. 0075 

C 0076 
C FF<L> L=lt... ,NRA»< NCAN-1 ) CONTAINS F< I , J ) I=1,...,NRA J=l,... 0077 

C , NCAN-1 AS DESCRIBED IN THE ABSTRACT. 0078 

C 0079 

C CCI } 1=1,... ,4»NRA*NRA CONTAINS DATA FROM RLSPR2 THAT IS 0080 

C NEEDED BY FIRE2. 0081 

C 0082 

C OUTPUTS 0083 

C 0084 

C FF(L) L=l ,NRA*NCAN CONTAINS F(I,J) I=1....,NRA J=l,..., 0085 

C NCAN AS DESCRIBED IN THE ABSTRACT. 0086 

C 0087 

C 0088 

C EXAMPLES 0089 

C 0090 

C I. EXTENSION OF A ONE-DIMENSIONAL PREDICTOR 0091 

C INPUTS - NRA = 1 NCAT = 5 NCAN = 5 0092 

C AAU..15) = 1.000,-0.499,0.246,-0. 117, 0.047 C<H * 1.001 0093 

C NRR * 1 NCR = 2 RRU...2) = 1.25,. 50 0094 

C NRG * 1 G(l) = 0. 0095 

C FFU...4) = 0.997,-0.493,0.235,-0.094 0096 
C USAGE - CALL FIRE2<NRA, NCAT, NCAN, AA, NRR, NCR, RR,NRG»GG,FF,C) 0097 

C OUTPUTS - FFU...5) = 0.999,-0.498,0.246,-0.117,0.047 0098 

C 0099 

C 2. CONSTRUCTION OF A GENERAL FILTER USING RLSPR2. 0100 

C INPUTS - NRA * 3 NCAT = 5 NCAN = 0 0101 

C NRR » 3 NCR = 3 RRC1...9) = 0.302, 0.105# 0.010, 0102 

C 1.340, 0.621, 0.020, 0103 

C 0.302, 0.105, 0.010 0104 

C NRG = 1 NCG = 5 GGU...5) = 0. , 0. , 1. , 0. , 0. 0105 

C USAGE - DO 10 1=1, NCAT 0106 

C CALL RLSPR2( NRA,NCAT ,NCAN, AA,NRR,NCR,RR,C, I ANSI 0107 

C IG * 1 + U-1)»NRG 0108 
C CALL FIRE2(NRA, NCAT, NCAN, AA, NRR, NCR, RR, NRG, GG,FF,C1 0109 

C 10 CONTINUE 0110 

C OUTPUTS - IANS = 0 FFU...15) = 0.002, 0.181,-0.393, 0.181, 0.002, 0111 
C 0.045,-0.609, 1.417,-0.609, 0.045, 0112 

C 0.002, 0.181,-0.393, 0.181, 0.002 0113 

C 0114 

C 0115 

C PROGRAM FOLLOWS BELOW 0116 

C 0117 

C 0118 

DIMENSION AA(2) ,RR<2) ,GG(2) ,FF( 2) ,C<2 J ,CM< 2) 0119 

COMMON CM 0120 

L=NRA 0121 

M»NCAN-1 0122 

MT=NCAT 0123 

LL=L*L 0124 

LMT=L*MT 0125 

CALL IXCARG (C,IC1) 0126 

IC2=IC1+LL 0127 

IC3=IC2+LL 0128 

IC4=IC3*L 0129 

IF CM) 10,10,20 0130 

10 CALL STZ (LMT,FF) 0131 

20 CONTINUE 0132 

Ml=(NRR*l)/2 0133 

JCl=IC3 0134 

IGl=NRG-INRG-L>/2 0135 

DO 50 1=1, L 0136 

CALL DOTP U,M,FF,NRR,NCR,RR,M1-I,1,CM(JC1),~2.) 0137 

IF tXMINOF(IGl,NRG-IGl+l>> 40,40,30 0138 

30 CONTINUE 0139 

CM( JCi)=CM{ JCi)-GG( IG1) 0140 

40 IG1=IG1-1 0141 

50 JC1=JC1+1 0142 

CALL MATML3 ( L,L , 1 , CM( IC2) , CMUC3) ,0,CM { IC4 ) , 01 0143 

M=M+1 0144 

LM=L*M 0145 

IA=LM 0146 

DO 60 11=1, LM 0147 

CALL DOTJ (L,1,CM(IC4),LMT,AA(IA),FF( II), 1,1) 0148 

60 IA=IA-1 0149 
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RETURN 
END 



0150 
0151 
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» FIXV * * FIXV * 



► FIXV (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 


0104 


y FAP 






0001 


p | xv 






0002 


COUNT 


100 




0003 


LBL 


FIXV 




0004 


ENTRY 


FIXV (X,LX,IXFIXD) 




0005 


ENTRY 


FIXVR (X, LX t IXFIXO) 




0006 








0007 




ABSTRACT 




0008 








0009 


y TITLE - FIXV 


WITH SECONDARY ENTRY FIXVR 




0010 


► F I X A 


FLOATING VECTOR WITH OR WITHOUT ROUNDING 


0011 








0012 




FIXV FIXES A FLOATING VECTOR TO A FORTRAN-I I FIXED POINT 


0013 




INTEGER VECTOR WITH TRUNCATION OF THE 


FRACTIONAL PART. 


0014 




FIXVR ROUNDS THE FRACTIONAL PART. 




0015 








0016 


> LANGAUGE 


FAP SUBROUTINES (FORTRAN-I I COMPATIBLE) 


0017 


► EQUIPMENT - 


709 OR 7090 (MAIN FRAME ONLY) 




0018 


► STORAGE 


35 REGISTERS 




0019 


► SPEED 


7090 709 




0020 


(■ 


FIXV 31 + (27 OR 28)*LX MACHINE CYCLES, 


0021 


y 


FIXVR 33 ♦ (33 OR 34)*LX LX * VECTOR LENGTH 


0022 


> AUTHOR 


S.M. SIMPSON, AUGUST 1963 




0023 








0024 




USAGE 




0025 








0026 


y TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 




0027 


> AND FORTRAN SYSTEM ROUTINES - (NONE) 




0028 








0029 


>. FORTRAN USAGE 




0030 


* CALL FIXV (X,LX,IXFIXD) 




0031 


► CALL FIXVR (X,LX,IXFIXD) 




0032 








0033 


► INPUTS 






0034 


y 






0035 


► X(I) 


1=1. ..LX IS THE FLOATING VECTOR 




0036 


h 






0037 


LX 


SHOULD EXCEED 0 




0038 








0039 


► OUTPUTS 


STRAIGHT RETURN WITH NO OUTPUTS IF LX 


LSTHN 1 


0040 








0041 


h IXFIXD(I) 


1 = 1. ..LX IS THE FIXED FORM OF XII. ..LX) 


0042 




WITH TRUNCATION IF FIXV IS USED 




0043 




WITH ROUNDING IF FIXVR IS USED 




0044 




EQUIVALENCE (X* IXFIXD) IS PERMITTED 




0045 








0046 


► EXAMPLES 






0047 








0048 


> 1. INPUTS - 


XU...5) * 1.2,1.5,1.9,2.0,-3.5 




0049 




EQUIVALENCE (X, 1X3) 1X4=0 




0050 


► USAGE 


CALL FIXV (X, 5,1X1) 




0051 




CALL FIXVR(X,5,IX2) 




0052 




CALL FIXV IX, 1, X) 




0053 




CALL FIXV CX,0,IX4) 




0054 


OUTPUTS - 


IXK1...5) » 1,1,1,2,-3 




0055 




1X2(1. ..5) = 1,2,2,2,-4 




0056 




1X3(1) = X(l) = 1 1X4 * 0 (NO OUTPUT 


CASEI 


0057 








0058 


> PROGRAM FOLLOWS BELOW 




0059 








0060 








0061 


► NO TRANSFER VECTOR 




0062 


HTR 


0 XR4 




0063 


BCI 


1,FIXV 




0064 


y PRINCIPAL ENTRY. F I XV ( X, LX , IXF IXD) 




0065 


FIXV CLA 


NORND 




0066 


SETUP STA 


TRA 




0067 


SXD 


FIXV-2,4 




0068 


Kl CLA 


1,4 




0069 


ADD 


Kl A(X)+l 




0070 


STA 


GET 




0071 


CLA 


3,4 




0072 


ADD 


Kl 




0073 


STA 


STORE 




0074 
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CLA» 


2,4 




0075 




TMI 


LEAVE 




0076 




POX 


0,4 




0077 




TXL 


LEAVE 1 4 ,0 




0078 


• FIXING LOOP 






0079 


GET 


CLA 


»*,4 


»**A(X)+1 


0080 




UFA 


OCTKl 




0081 




LRS 


0 




0082 




ANA 


0CTK2 




0083 




LLS 


0 




0084 


TRA 


TRA 


** 


«**ALS OR ROUND 


0085 


ALS 


ALS 


18 




0086 


STORE 


STO 


**,4 


**=A( IXFXD)+1 


0087 




TIX 


GET, 4,1 




0088 


* EXIT 








0089 


LEAVE 


LXD 


FIXV-2,4 




0090 




TRA 


4,4 




0091 


* ROUNDING INSERTION 




0092 


ROUND 


RQL 


8 




0093 




RND 






0094 




TRA 


ALS 




0095 


* SECOND ENTRY. FIXVR(X,LX, 


IXFIXD) 


0096 


FIXVR 


CLA 


RND 




0097 




TRA 


SETUP 




0098 


» CONSTANTS 






0099 


NORND 


TRA 


ALS 




0100 


RND 


TRA 


ROUND 




0101 


OCTK1 


OCT 


233000000000 




0102 


OCTK2 


OCT 


000000377777 




0103 




END 






0104 
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FIXVR * ♦ FIXVR 



REFER TO REFER TO 

FIXV FIXV 



FLOATA » * FLDATA 



REFER TO 

FXOATA 



REFER TO 
FXOATA 
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* FLOATM (FUNCTION) 9/29/64 LAST CARD IN DECK IS NO* 0090 

* FAP 0001 
♦FLOATM 0002 

COUNT 80 0003 

LBL FLOATM 0004 

ENTRY FLOATM ( INTEGR ) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - FLOATM 0009 

* FLOAT ANY MACHINE LANGUAGE INTEGER 0010 

* 0011 

* FLOATM ASSUMES ITS ARGUMENT IS A 35 BIT PLUS SIGN 0012 

* INTEGER (BINARY POINT TO RIGHT OF BIT 35) AND CONVERTS 0013 

* IT TO EQUIVALENT FLOATING POINT FORM. THERE ARE NO 0014 

* RESTRICTIONS ON THE ARGUMENT. 0015 

* 0016 
» LANGUAGE - FAP SUBROUTINE (FORTRAN II FUNCTION) 0017 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0018 

* STORAGE - 25 REGISTERS 0019 

* SPEEO - ABOUT 17 MACHINE CYCLES IF INTEGER LSTHN 2»»27 0020 

* ABOUT 46 MACHINE CYCLES IF INTEGER GRTHN* 2**27 0021 

* AUTHOR - S.M. SIMPSON JR, NOV/1962 0022 

* 0023 

* USAGE 0024 

* 0025 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0026 

* AND FORTRAN SYSTEM ROUTINES - NONE 0027 

* 0028 

* FORTRAN USAGE 0029 

* FLTG = FLOAT MF ( INTEGR ) 0030 

* 0031 

* INPUTS 0032 

* 0033 

* INTEGR IS ANY 35 BIT PLUS SIGN INTEGER 0034 

* 0035 

* OUTPUTS 0036 

* 0037 

* FLTG IS THE EQUIVALENT FLOATING POINT FORM OF INTEGR 0038 

* 0039 

* EXAMPLES 0040 

* 0041 

* 1. INPUTS - INTEGR « OCT 000000000004 0042 

* OUTPUTS - FLTG = 4. 0043 

* 0044 

* 2. INPUTS - INTEGR * OCT 400000000004 0045 

* OUTPUTS - FLTG « -4. 0046 

* 0047 

* 3. INPUTS - INTEGR OCT 377777777777 0048 

* OUTPUTS - FLTG » 34359738367.0 ( GOOO TO 8 PLACES) 0049 

* 0050 

* 4. INPUTS - INTEGR » OCT 777777777777 0051 

* OUTPUTS - FLTG = -34359738367.0 0052 

* 0053 

* 5. INPUTS - INTEGR = OCT 000000000000 0054 

* OUTPUTS - FLTG = 0.0 0055 

* 0056 

* 6. INPUTS - INTEGR » OCT 400000000000 0057 

* OUTPUTS - FLTG * -0.0 0058 

* 0059 

* 7. INPUTS - INTEGR = OCT 001000000000 0060 

* OUTPUTS - FLTG = 134217728.0 0061 

* 0062 
HTR 0 0063 
BCI 1 f FLOATM 0064 

FLOATM SXD FLOATM-2,4 0065 

* CHECK FOR SPECIAL CASE OF MAGNITUDES EXCEEDING 2**27-1 0066 

LAS KOOl 0067 

TRA BIG 0068 

TRA BIG 0069 

ORA K233 0070 

FAD K233 0071 

LEAVE TRA 1 T 4 0072 

* HANDLE BIG NUMBERS 0073 
BIG LRS 27 0074 
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STQ 


TEMP 


0075 




ORA 


K266 


0076 




FAO 


K233 


0077 




STO 


TEMP2 


0078 




CLA 


TEMP 


0079 




ARS 


8 


0080 




ORA 


K233 


0081 




FAD 


K233 


0082 




FAD 


TEMP2 


0083 




TRA 


LEAVE 


0084 


KOOl 


OCT 


OOIOOOOOOOOO 


0085 


K233 


OCT 


233000000000 


0086 


K266 


OCT 


266000000000 


0087 


TEMP 


PZE 


*• 


0088 


TEMP2 


PZE 


** 


0089 




END 
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FLOATV 



PROGRAM LISTINGS 



«»••»•**•**••••****•*«•• 

* FLOATV * 



• FLOATV (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0080 



» FAP 










0001 


•FLOATV 










0002 


COUNT 


100 








0003 


LBL 


FLOATV 








0004 


ENTRY 


FLOATV (IX,LIX,XFLOTD) 








0005 


• 










0006 


• 


ABSTRACT 








0007 


* 










0008 


* TITLE - FLOATV 








0009 


» FLOAT 


A VECTOR 








0010 


• 










0011 


• 


FLOATV CONVERTS A FORTRAN— 1 1 FIXED 


VECTOR TO FLOATING PT. 


0012 


• 










0013 


» LANGUAGE 


FAP SUBROUTINE, FORTRAN-I I COMPATIBLE 




0014 


» EQUIPMENT - 


709 OR 7090 (MAIN FRAME ONLY) 








0015 


» STORAGE 


22 REGISTERS 








0016 


• SPEED 


27 ♦ 17.4»LX MACHINE CYCLES WHERE 


LX * 


VECTOR LENGTH 


0017 


• AUTHOR 


S.M. SIMPSON, AUGUST 1963 








0018 


• 










0019 


• 


USAGE 








0020 


• 










0021 


• TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 








0022 


• AND FORTRAN SYSTEM ROUTINES - (NONE) 








0023 


• 










0024 


* FORTRAN USAGE 








0025 


« CALL FLOATV(IX,LIX,XFLOTD) 








0026 


• 










0027 


« INPUTS 










0028 


» 










0029 


• IXC I) 


1=1.. .LIX IS THE FIXED POINT VECTOR 




0030 


• 










0031 


* LIX 


MUST EXCEED ZERO 








0032 


• 










0033 


* OUTPUTS 


STRAIGHT RETURN WITH NO OUTPUT 


IF 


LIX 


LSTHN 1 


0034 


• 










0035 


• XFLOTD(I) 


1*1. ..LIX IS THE FLOATED FORM 


OF 


IX(1. 


..LIX) 


0036 


• 










0037 


• 


EQUIVALENCE (IX, XFLOTD) IS PERMITTED 




0038 


• 










0039 


» EXAMPLES 










0040 


• 










0041 


• 1. INPUTS - 


IXU...3) = 1,-3,7 EQUIVALENCE 


( IX, X2) 


X3»0.0 


0042 


• 










0043 


» USAGE 


CALL FLOATV( IX, 3, XI) 








0044 


• 


CALL FLOATV( IX,1,IX) 








0045 


* 


CALL FLOATV( IX,-1,X3) 








0046 


• OUTPUTS - 


XK1...3) = 1.0,-3.0,7.0 X2(l) 


s 


IX(1) 


» 1.0 


0047 


• 


X3 » 0.0 (NO OUTPUT CASE) 








0048 


• 










0049 


• PROGRAM FOLLOWS BELOW 








0050 


• 










0051 


• 










0052 


» NO TRANSFER VECTOR 








0053 


HTR 


0 XR4 








0054 


BCI 


1, FLOATV 








0055 


• ONLY ENTRY. 


FLOATV(IX,LIX,XFLOTD) 








0056 


FLOATV SXD 


FLOATV-2,4 








0057 


Kl CLA 


It* 








0058 


ADD 


Kl A(IX)+1 








0059 


STA 


GET 








0060 


CLA 


3,4 








0061 


ADD 


Kl A(XFL0TD)+1 








0062 


STA 


STORE 








0063 


CLA* 


2,4 LIX 








0064 


TMI 


LEAVE 








0065 


PDX 


0,4 








0066 


TXL 


LEAVE, 4,0 








0067 


* FLOATING LOOP 








0068 


GET CLA 


*»,4 *»=A(ixm 








0069 


LRS 


18 








0070 


ORA 


OCTK 








0071 


FAD 


OCTK 








0072 


STORE STO 


»*,4 **=A(XFLTD)*1 








0073 


TIX 


GET, 4,1 








0074 
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* EXIT 0075 
LEAVE LXD FLOATV-2,4 0076 

TRA 4,4 0077 

* CONSTANTS 0078 
OCTK OCT 233000000000 0079 

END 0080 
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• FMTOUT (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0070 

* LABEL 0001 
CFMTOUT 0002 

SUBROUTINE FMTOUT ( IT APE , FMT ) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - FMTOUT 0007 

C WRITE OUTPUT TAPE WITH NORMAL OR LITERAL FORMAT VECTOR 0008 

C 0009 

C FMTOUT HAS TWO ARGUMENTS, ITAPE AND FMT, WHERE FMT IS 0010 

C A NORMAL OR LITERAL FORMAT VECTOR* THE FUNCTION OF 0011 

C FMTOUT IS THAT OF THE FORTRAN STATEMENT 0012 

C 0013 

C WRITE OUTPUT TAPE ITAPE, FMT 0014 

C 0015 

C 0016 

C LANGUAGE - FORTRAN-II SUBROUTINE 0017 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME PLUS ONE TAPE UNIT! 0018 

C STORAGE - 51 REGISTERS 0019 

C SPEED - 0020 

C AUTHOR - S.M. SIMPSON JR., SEPTEMBER 1963 0021 

C 0022 

C USAGE 0023 

C 0024 

C TRANSFER VECTOR CONTAINS ROUTINES - FNDFMT, RPLFMT 0025 

C AND FORTRAN SYSTEM ROUTINES - (STH),(FIL) 0026 

C 0027 

C FORTRAN USAGE 0028 

C 0029 

C CALL FMTOUT( ITAPE, FMT) 0030 

C 0031 

C INPUTS DEFINE A NORMLIT FORMAT VECTOR AS EITHER 0032 

C A) A NORMAL FORMAT VECTOR, 0033 

C OR B) LITERAL HOLLERITH IN A CALLING SEQUENCE WHOSE 0034 

C CHARACTERS (READING CONTINUOUSLY FROM LEFT TO RIGHT) 0035 

C ARE THE DESIRED FORMAT STRIPPED OF THE ENCLOSING 0036 

C PARENTHESES. THE FIRST AND SECOND CHARACTERS MUST 0037 

C NOT BE QUOTE ( UNQUOTE OR QUOTE ) UNQUOTE 0038 
C RESPECTIVELY. (TWO BLANKS FOLLOWED BY < WOULD BE OK. ) 0039 

C 0040 

C ITAPE IS LOGICAL NUMBER OF DESIRED OUTPUT TAPE. 0041 

C 0042 

C FMT ( I ) 1=1,2,... OR 1=1,0,-1,... IS THE NORMLIT FORMAT VECTOR 0043 

C TO BE WRITTEN OU ! ON TAPE ITAPE. 0044 

C 0045 

C OUTPUTS THE FORMAT IS WRITTEN OUT AS ILLUSTRATED BELOW. 0046 

C 0047 

C EXAMPLES 0048 

C 0049 

C 1. INPUTS - FMT(1...4) = 21H(16H ORDINARY FORMAT) 0050 

C USAGE - CALL FMTOUT ( 2, FMT ) 0051 

C CALL FMT0UT(2,18H15H LITERAL FORMAT ) 0052 

C OUTPUTS - THE FOLLOWING TWO LINES 0053 

C ORDINARY FORMAT 0054 

C LITERAL FORMAT 0055 

C WILL BE PRINTED OFF-LINE FROM LOGICAL TAPE 2. 0056 

C 0057 

C PROGRAM FOLLOWS BELOW 0058 

C 0059 

DIMENSION C0M(2) 0060 

COMMON COM 0061 

CALL FNDFMT ( FMT, IXCFMT ) 0062 

CALL RPLFMT(COM,COM( IXCFMT)) 0063 

GO TO 20 0064 

10 CALL RPLFMT ( COM ( I XCFMT ) , COM ) 0065 

GO TO 9999 0066 

20 WRITE OUTPUT TAPE ITAPE, COM 0067 

GO TO 10 0068 

9999 RETURN 0069 

END 0070 
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* FNDFMT (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO* 0202 

* FAP 0001 
•FNDFMT 0002 

COUNT 150 0003 

L8L FNDFMT 0004 

ENTRY FNDFMT (FMT, IXCFMT) 0005 

» 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - FNDFMT 0009 
» ACCESS TO LITERAL OR ORDINARY FORMAT 0010 
» 0011 

* FNDFMT SUPPLIES THE INDEX WITH RESPECT TO THE COMMON 0012 
« BLOCK OF A FORMAT STATEMENT, THE FORMAT IS SUPPLIED 0013 

* AS AN ARGUMENT WHICH IS EITHER OF THE ORDINARY FORM 0014 

* (A HOLLERITH VECTOR WHOSE FIRST CHARACTER IS A LEFT 0015 
» PARENTHESIS) OR IS A LITERAL HOLLERITH VECTOR ARGUMENT 0016 

* REPRESENTING THE FORMAT MINUS ITS ENCLOSING PARENTHESES 0017 
» AND TERMINATED BY AN ALL-ONES FENCE, IN THE LATTER 0018 

* CASE FNDFMT REVERSES THE LITERAL HOLLERITH AND ADDS 0019 

* THE NECESSARY PARENTHESES. SUBSEQUENT CALLS OF FNDFMT 0020 

* WITH THE REVERSED HOLLERITH WILL NOT LEAD TO RE— REVERSAL* 0021 

* 0022 

* AN ORDINARY TYPE FORMAT MUST NOT CONTAIN A ) AS THE 0023 

* FIRST CHARACTER AFTER ITS <, ( ILLEGAL ANYWAY). 0024 
» 0025 
» A LITERAL TYPE FORMAT MUST NOT CONTAIN A ) AS ITS 0026 

* SECOND CHARACTER, OR A ( AS ITS FIRST CHARACTER, 0027 
» 0028 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN-I I COMPATIBLE) 0029 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0030 

* STORAGE - 88 REGISTERS 0031 

* SPEED - 0032 

* AUTHOE - S.M. SIMPSON, SEPTEMBER 1963 0033 

* 0034 
» USAGE 0035 

* 0036 
» TRANSFER VECTOR CONTAINS ROUTINES - REVER 0037 
» AND FORTRAN SYSTEM ROUTINES - (NONE) 0038 
» 0039 

* FORTRAN USAGE 0040 
» CALL FNDFMT ( FMT , IXCFMT ) 0041 

* 0042 

* INPUTS 0043 

* 0044 

* FMT ( I ) IS A REVERSED OR UNREVERSED LITERAL HOLLERITH VECTOR, OR 0045 

* AN ORDINARY FORMAT VECTOR, AS DESCRIBED IN ABSTRACT, 0046 
» 0047 

* OUTPUTS 0048 

* 0049 

* IXCFMT IS THE INDEX WITH RESPECT TO COMMON OF THE FORMAT 0050 

* = 77461 (OCTAL) - XLOCF ( FORMAT ) ♦ 1 0051 

* WHERE XLOCF ( FORMAT ) * XLOCF ( FMT ) IF FMT ( I ) ORDINARY 0052 

* = XLOCF( FENCE) OTHERWISE 0053 

* (THE FENCE IS WIPED OUT) 0054 
» 0055 
» FMT ( I ) IS UNDISTURBED IF, ON INPUT, IT WAS EITHER A NORMAL 0056 

* FORMAT VECTOR OR A PREVIOUSLY REVERSED LITERAL FORMAT 0057 

* VECTOR. IF, ON INPUT, FMT ( I ) WAS A LITERAL FORMAT 0058 
» THE FOLLOWING REVERSAL TRANSFORMATION OCCURS. 0059 
» (INPUT) (OUTPUT) 0060 

* FMT ( 1 ) * 6HABCDEF 6HZ)000M 0061 

* FMT ( 0 ) = 6HGHIJKL 6HTUVWXY 0062 

* ETC 0063 

* FMT(-N+1) * 6HUVWXYZ 6HFGHIJK 0064 

* FMT (-N ) = 0CT7777777777 6H( ABCDE 0065 
» WHERE M = N+l 0066 

* 0067 

* EXAMPLES 0068 

* 0069 

* 1. WITH ORDINARY FORMATS 0070 
» INPUTS - FMTl(i*,.2) = 12H( 15, 3X, F9.5) 0071 

* USAGE - CALL FNDFMT ( FMT 1 , IXCF 1 ) 0072 
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• 


OUTPUTS - 


IXCF1 = 77461(0CTAL)-XL0CF(FMTim, AND 


0073 


• 




FMTK1...2) IS UNCHANGED. 


0074 


• 






0075 


» 


2. WITH LITERAL FORMATS AND REPEATED USAGE 


0076 


• 


INPUTS - 


FMT2C3) = 6HI5,12X FMT2(2) = 6H,5F9.5 


0077 


• 




FMT2(1) = 0CT777777777777 FMT3C2) » 3H5I5 


0078 


* 




FMT3(1) * OCT777777777777 


0079 


• 


USAGE 


DO 10 1=1,2 


0080 


* 




CALL FNDFMT ( FMT21 3),IXCF2(I)) 


0081 


• 




10 CALL FNDFMT(FMT3(2),IXCF3(I)) 


0082 


* 


OUTPUTS - 


FMT2(1) = 6HCI5,12 FMT2(2) = 6HX,5F9. 


0083 


• 




FMT2C3) * 6H5)0002 


0084 


* 




IXCF2U) = IXCF2(2) » 7746 1-XLOCF ( FMT2I 1 ) ) + l 


0085 


* 




FMT3(1) = 4H(5I5 FMT3I2) * 6H )0001 


0086 


• 




IXCF3(1) = IXCF3C 2 ) « 77461-XLOCF ( FMT3 ( 1 ) ) + l 


0087 


* 






0088 


* 


PROGRAM FOLLOWS BELOW 


0089 


• 






0090 


* 






0091 


• 


TRANSFER VECTOR CONTAINS REVER 


0092 




HTR 


0 XR1 


0093 




HTR 


0 XR4 


0094 




BCI 


1, FNDFMT 


0095 


* 


ONLY ENTRY. 


FNDFMT ( FMT, IXCFMT ) 


0096 


FNDFMT SXD 


FNDFMT-2,4 


0097 




SXD 


FNDFMT-3,1 


0098 


• 


GET FIRST TWO CHARACTERS OF FMT(l) 


0099 




CLA* 


1,4 FMT ( 1 ) 


0100 




STA 


LFMT (PUT ASIDE POSSIBLE LENGTH) 


0101 




XCA 




0102 




PXA 


0,0 


0103 




LGL 


6 BITS S,l...5 


0104 




STO 


CI 


0105 




PXA 


0,0 


0106 




LGL 


6 BITS 6.. .11 


0107 




STO 


C2 


0108 


• 


CHECK FOR C2 


« ). IF SO, MUST BE A REVERSED FORMAT. 


0109 




CLA 


C2 


0110 




CAS 


RPAREN 


0111 




TRA 


*+2 NO 


0112 




TRA 


CASE2 YES 


0113 


* 


IF NOT, CHECK FOR CI » (. IF SO, MUST BE ORDINARY FORMAT. 


0114 




CLA 


CI 


0115 




CAS 


LPAREN 


0116 




TRA 


*+2 NO 


0117 




TRA 


CASE1 YES 


0118 


* 


IF NOT WE HAVE CASE OF UNREVERSED LITERAL HOLLERITH 


0119 


» 






0120 


* 


FIRST FIND ITS LENGTH, LFMT (DOESNT INCLUDE THE FENCE) 


0121 




AXT 


0,1 XR1 IS COUNTER 


0122 




CLA 


1,4 TSX A(FMT),0 


0123 




PAC 


0,4 -A(FMT) TO XR4 


0124 


CAL1 CAL 


0,4 


0125 




LAS 


FENCE 


0126 




NOP 


(IMPOSSIBLE) 


0127 




TRA 


COVER 


0128 




TXI 


*+l,l,l 


0129 




TXI 


CAL1,4,-1 


0130 


* 


MAKE SETTINGS DEPENDING ON LFMT. 


0131 


COVER LXD 


FNDFMT-2, 4 


0132 




SXD 


TXL2,1 


0133 




SXD 


CARRY, 1 (TEMP) 


0134 




SXA 


LFMT , 1 


0135 




PXA 


0,1 


0136 




ADD 


1,4 A ( FMT ) +LFMT 


0137 




STA 


LDQ2 


0138 




ADD 


Kl A ( FMT ) 4-LFMT + 1 


0139 




STA 


SLW2 


0140 




SUB 


Kl 


0141 




SUB 


Kl A( FMT ) +LFMT-1 


0142 




STA 


TSX1 


0143 




STA 


TSX3 


0144 


• 


REVERSE FMT( 1)...FMT(1-LFMT+1) 


0145 




TSX 


$REVER,4 


0146 


TSX1 TSX 


*»,0 ««=A(FMT )+LFMT-l 


0147 
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TSX CARRY, 0 0148 

TSX3 TSX »*,0 **~A(FMT )+LFMT— 1 0149 

LXD FNDFMT— 2,4 0150 

* INITIALIZE CARRY REGISTER TO LPAREN 0151 

CLA LPAREN 0152 

STO CARRY 0153 

* FORM FMT(-LFMT+l,-LFMT+2,...,0) 0154 
» 0155 

AXT 1,1 0156 

L0Q2 LDQ **»1 **=A(FMT)+LFMT 0157 

CAL CARRY 0158 

LGL 30 0159 

SLW2 SLW **,1 ***A(FMT)+LFMT+1 0160 

PXA 0,0 0161 

LGL 6 0162 

SLW CARRY 0163 

TXI *+l,l,l 0164 

TXL2 TXL LDQ2,1,** **=LFMT 0165 

* THEN FORM AND SET FMT(l) 0166 

CAL CARRY 0167 

LGL 30 0168 

ACL RPADJ 0169 

ACL LFMT 0170 

SLW* 1,4 0171 

* FINALLY FORM ADDRESS OF FORMAT AS IN CASE 2 0172 

* 0173 

* CASE 2, FORMAT HAS BEEN PREVIOUSLY REVERSED. 0174 

* LENGTH IS GIVEN BY C4,C5,C6 (IN LFMT) 0175 
CASE2 CLA LFMT 0176 

ADD 1,4 TSX A(FMT)+L,0 0177 

TRA LEAVE 0178 

* CASE 1. FORMAT IS ALREADY CORRECT IN FMT 0179 
CASE1 CLA 1,4 TSX A(FMT),0 0180 

* EXIT ROUTINE. SETS IXCFMT GIVEN MACHINE LOCATION OF FMT IN 0181 

* ADDRESS OF AC 0182 
» IXCFMT * 7746U1-ADDRESS 0183 

LEAVE LXD FNDFMT— 3, 1 0184 

STA LFMT (SET ADDRESS ASIDE) 0185 

CLA KCOMON 0186 

SUB LFMT 0187 

ALS 18 0188 

STO* 2,4 0189 

TRA 3,4 0190 

* CONSTANTS, TEMPORARIES 0191 
Kl PZE I 0192 
RPADJ BCI 1,0)0000 0193 

LPAREN BCI 1,00000( 0194 

RPAREN BCI 1,00000) 0195 

KCOMON OCT 000000077462 0196 

FENCE OCT 777777777777 0197 

LFMT PZE ** **=FMT LENGTH (ALSO TEMP FOR ADDRESS) 0198 

CI PZE ** 0199 

C2 PZE ** 0200 

CARRY PZE ** (ALSO USED AS TEMP FOR LFMT IN DECRI 0201 

END 0202 
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* FRAME (709) (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0033 

* FAP 0001 
♦FRAME (709) 0002 

COUNT 30 0003 

LBL FRAME 0004 

ENTRY FRAME 0005 

» 0006 

* ABSTRACT 0007 

» 0008 

* TITLE - FRAME 0009 
» ADVANCE FILM FRAME ON SCOPE 0010 

* FRAME ADVANCES THE FILM IN THE SCOPE CAMERA ONE FRAME. 0011 
» 0012 

* LANGUAGE - FAP, SUBROUTINE (FORTRAN COMPATIBLE) 0013 

* EQUIPMENT - 709 (MAIN FRAME AND SCOPE) 0014 

* STORAGE - 4 REGISTERS 0015 
» SPEED - 500 MS FOR FRAME TO ADVANCE. 0016 

* AUTHOR - R.A. WIGGINS DEC, 1962 0017 
» 0018 
» USAGE 0019 

* 0020 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0021 
» AND FORTRAN SYSTEM ROUTINES - NONE 0022 

* 0023 

* FORTRAN USAGE 0024 

* CALL FRAME 0025 

* 0026 
» THE FILM IS ADVANCED ONE FRAME 0027 

* 0028 
BCI 1 , FRAME 0029 

FRAME WRS 24 0030 

CFF 0031 

TRA 1,4 0032 

END 0033 
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» FRAME (7090) (SUBROUTINE) 9/4/64 LAST CARO IN DECK IS NO* 0046 

* FAP 0001 
♦FRAME (7090) 0002 

COUNT 40 0003 

LBL FRAME 0004 

ENTRY FRAME 0005 

* 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - FRAME (7090) 0009 

* ADVANCE FILM FRAME ON SCOPE 0010 

* 0011 
» FRAME ADVANCES THE FILM IN THE SCOPE CAMERA ONE FRAME. 0012 

* 0013 

* LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0014 

* EQUIPMENT - 7090 (MAIN FRAME, DATA CHANNEL D, AND SCOPE) 0015 
« STORAGE - 9 REGISTERS 0016 
« SPEEO - 500 MS FOR FRAME TO ADVANCE. 0017 

* AUTHOR - MIT COMPUTATION CENTER STAFF 0018 

* 0019 

* USAGE 0020 

* 0021 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0022 

* AND FORTRAN SYSTEM ROUTINES - NONE 0023 

* 0024 

* FORTRAN USAGE 0025 

* CALL FRAME 0026 

* 0027 
» THE FILM IS ADVANCED ONE FRAME. 0028 

* 0029 

* 0030 
» PROGRAM FOLLOWS BELOW 0031 

* 0032 

* FOLLOWING CARD DESIGNATES THE DATA CHANNEL THAT CRT IS ATTACHED TO. 0033 

* TO CHANGE, ALTER THE LETTER DESIGNATION ONLY AND REASSEMBLE. 0034 
X TAPENO Dl 0035 
SCPAD EQU X-105 0036 

BCI 1, FRAME 0037 

FRAME PSE SCPAD 0038 

WRS SCPAD 0039 

RCHX I0CD 0040 

WRS SCPAD 0041 

RCHX IOCD 0042 

PSE SCPAD OCTAL FOR CFFX 0043 

TRA 1,4 0044 

IOCD IOCD 0,0,0 0045 

END 0046 
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* FRQCT1 (SUBROUTINE) 9/29/64 LAST CAKD IN DECK IS NO. 0094 

» LABEL 0001 

CFRQCT1 0002 

SUBROUTINE FRQCT1 ( IX,NX, IXLO, IXHI, ICT, I ANS ) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - FRQCT1 0007 

C FREQUENCY DISTRIBUTION OF A FIXED POINT VECTOR 0008 

C 0009 

C FRQCT1 MAKES A FREQUENCY COUNT OF AN INTEGER SEQUENCE WITH 0010 

C VALUES IN A SPECIFIED RANGE. FOR EACH INTEGER VALUE IN 0011 

C THE INCLUSIVE RANGE IXLO TO IXHI, THE NUMBER OF 0012 

C OCCURRENCES OF THIS VALUE IN THE INTEGER SEQUENCE IS 0013 

C COUNTED, 0014 

C 0015 

C LANGUAGE - FORTRAN II SUBROUTINE 0016 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0017 

C STORAGE - 117 REGISTERS 0018 

C SPEED - 0019 

C AUTHOR - S. M. SIMPSON 0020 

C 0021 

C USAGE 0022 

C 0023 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0024 

C AND FORTRAN SYSTEM ROUTINES - NONE 0025 

C 0026 

C FORTRAN USAGE 0027 

C CALL FRQCTKIX, NX, IXLO, IXHI, ICT, IANS) 0028 

C 0029 

C INPUTS 0030 

C 0031 

C IX(I) 1=1. ..NX IS THE GIVEN INTEGER SEQUENCE 0032 

C IXLO LSTHN OR = IX(I) LSTHN OR = IXHI. 0033 

C 0034 

C NX IS THE NUMBER OF IX VALUES IN THE SEQUENCE. 0035 

C MUST BE GRTHN 0. 0036 

C 0037 

C IXLO IS AN INTEGER 0038 

C LSTHN OR = ALL IX(I) 0039 

C IXLO MAY BE NEG. 0040 

C 0041 

C IXHI IS AN INTEGER 0042 

C GRTHN OR = ALL IX(I) 0043 

C IXHI MAY BE NEG. 0044 

C 0045 

C OUTPUTS 0046 

C 0047 

C ICT(I) 1*1. ..NCT IS THE FREQUENCY COUNT WHERE 0048 

C ICT(l) * NUMBER OF MEMBERS OF THE INPUT SEQ » IXLO 0049 

C ICT(2) » NUMBER OF MEMBERS OF THE INPUT SEQ * IXLO+1 0050 

C ETC. 0051 

C ICT(NCT) * NUMBER OF MEMBERS OF THE INPUT SEQ = IXHI 0052 

C WHERE NCT * IXHI- IXLO+l 0053 

C 0054 

C IANS = 0 NORMAL 0055 

C * 1 ILLEGAL NX 0056 

C =2 ILLEGAL IXLO 0057 

C 0058 

C EXAMPLES OF FRQCT1 0059 

C 0060 

C 1. INPUTS - IXL0=3 IXHI=10 NX=3 IX( 1.. .3)^4,4,4 0061 

C OUTPUTS - ICTU...8) » 0,3,0,0,0,0,0,0 IANS*0 0062 

C 0063 

C 2. INPUTS - IXL0=5 IXHI=12 NX*7 I X( 1.. .7 ) = 5, 6, 7, 8,9, 10, 11 0064 

C OUTPUTS - ICTU...8) = 1,1,1,1,1,1,1,0 IANS=0 0065 

C 0066 

C 3. INPUTS - IXL0=5 IXHI=12 NX=0 0067 

C OUTPUTS - ERROR IANS=1 0068 

C 0069 

C 4. INPUTS - IXL0=13 IXHI*12 NX=7 0070 

C OUTPUTS - ERROR IANS=2 0071 

C 0072 

DIMENSION IX(2),ICT(2) 0073 

C SET UP AND CLEAR ICT(I). 0074 



»••••••*•*•»••»»•»•»«••• PROGRAM LISTINGS «#»♦*•♦«*»»»**»»#***»»** 

* FRQCTl ♦ * FRQCT1 * 

••••••••»•»*«**»**•**•*• •**•••*»***••*•••»•«*«•* 

(PAGE 2) (PAGE 2) 



IANS=0 0075 

NCT=IXHI-IXL0+1 0076 

NSHIFT=IXL0-1 0077 

IF (NX) 9991,9991,10 0078 

10 IF (NCT) 9992,9992,15 0079 

15 DO 20 1=1 , NCT 0080 

20 ICT(I)=0 0081 

C SCAN IX(I) TO MAKE COUNTS (PUT EACH IX IN RANGE 1 TO NCT FIRST). 0082 

DO 35 1=1, NX 0083 

IXI=IX(I)-NSHIFT 0084 

IF (IXI) 9992,9992,30 0085 

30 IF (IXI-NCT) 35,35,9992 0086 

35 ICTUXI)»ICTUXn + l 0087 

GO TO 9999 0088 

9999 RETURN 0089 

9991 IANS=1 0090 
GO TO 9999 0091 

9992 IANS=2 0092 
GO TO 9999 0093 
END 0094 



••••*•••*••»*•**•••*»*•• PROGRAM LISTINGS •**##♦#«**»##»***#♦*♦»** 

» FRQCT2 » » FRQCT2 * 

**•«**•»*•••••*»•»•«*•»« ***••»•****•»•***•*»»**» 

» FRQCT2 (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0211 

» FAP 0001 

•FRQCT2 0002 

COUNT 200 0003 

LBL FRQCT2 0004 

ENTRY FRQCT2 ( X ,LX, B, LB, ICOUNT, I ANS ) 0005 

* 0006 

* ABSTRACT 0007 

» 0008 

« TITLE - FRQCT2 0009 

* FREQUENCY COUNT OF NUMBER OF VALUES OF A SERIES IN GIVEN RANGES. 0010 

* 0011 

* FRQCT2 MAKES A FREQUENCY COUNT OF A FLOATING POINT, 0012 
« FORTRAN INTEGER, OR MACHINE LANGUAGE INTERGER SERIES FOR 0013 
» THE NUMBER OF VALUES LYING IN SPECIFIED RANGES. IT IS 0014 
» USEFUL IN COMPUTING EMPIRICAL PROBABILITY DENSITIES. 0015 
» 0016 

* THERE ARE LB RANGE LIMITS, B(I), 1=1, LB, AND HENCE LB+1 0017 
» RANGES. A NUMBER, X(J), IS SAID TO BE IN THE I-TH RANGE 0018 

* IF B(I-l) LSTHN OR EQUAL X(J) LSTHN B(I). A NUMBER IS IN 0019 
» THE FIRST RANGE IF IT IS LSTHN 8(1), AND IN THE LB+1 0020 
« RANGE IF GRTHN OR EQUAL B ( LB ) • THE INPUT SERIES X(I) MUST 0021 
» BE THE SAME MODE (FLOATING, INTEGER, ETC.) AS THE RANGE 0022 

* LIMITS BECAUSE THE METHOD USES CAS INSTRUCTIONS. 0023 
» 0024 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0025 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0026 

* STORAGE - 117 REGISTERS 0027 

* SPEED - 0028 

* AUTHOR - J. N. GALBRAITH 0029 
» 0030 
» USAGE 0031 

* 0032 
» TRANSFER VECTOR CONTAINS ROUTINES - NONE 0033 

* AND FORTRAN SYSTEM ROUTINES - NONE 0034 
» 0035 

* FORTRAN USAGE 0036 

* CALL FRQCT2(X, LX,B, LB, ICOUNT, IANS) 0037 

* 0038 
» INPUTS 0039 

* 0040 
» XU) 1*1. ..LX IS THE GIVEN SERIES. 0041 

* MAY BE FLOATING, FORTRAN INTEGER, OR MACHINE INTEGER. 0042 

* 0043 
» LX IS THE LENGTH OF THE X SERIES. 0044 

* MUST 8E GRTHN 0. 0045 
« 0046 

* B(I) 1*1. ..LB IS VECTOR OF RANGE LIMITS. B(I) LSTHN BU+l). 0047 

* RANGES INTO WHICH THE SERIES IS DIVIDED ARE (-INFINITY, 0048 

* LSTHN B(l)>, (GRTHN OR =B(i), LSTHN B<2)> ETC. 0049 

* MAY BE FLOATING, FORTRAN INTEGER , OR MACHINE INTEGER, 0050 

* BUT MUST BE THE SAME AS X(I) 0051 
» 0052 

* LB NUMBER OF RANGE LIMITS. 0053 

* MUST BE GRTHN 0. 0054 
» NOTE - NUMBER OF RANGES »1* NUMBER OF RANGE LIMITS. 0055 

* 0056 

* OUTPUTS 0057 

* 0058 

* ICOUNT(I) I=1...LB+1=NUMBER OF X VALUES IN EACH RANGE OF B. 0059 
« IC0UNT(1)=N0. X LSTHN B(l). ICOUNT( 2)=N0. X LSTHN B(2), 0060 
» GRTHN OR =B(1). 0061 

* ICOUNT(LB)=NO. X LSTHN B(L8), GRTHN 0R=B(LB-1). 0062 
» IC0UNT(LB+1)*N0. X GRTHN OR =B( LB ) . 0063 

* v 0064 

* IANS IANS=0, NORMAL 0065 
» IANS=1, ILLEGAL LX 0066 

* IANS*2, ILLEGAL LB 0067 
» IANS=3, WEIRD ERROR 0068 

* 0069 
» EXAMPLES 0070 

* 0071 

* 1. INPUTS - XU...15) * -21.,-20.,-15.,-14.,-12.,-ll.,-8.,-7.,0.,l., 0072 

* 2. 1,3. ,4. ,5. ,6. LX=15 B(1...5)= -20. 16. ,-7. 5 , 0. , ♦ 9 0073 

* LB=5 0074 
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OUTPUTS - ICOUNTd. 



.6) = 1,1,5,1,1,6, 



IANS=0 



INPUTS 
OUTPUTS 



3. INPUTS 
OUTPUTS 



INPUTS 
OUTPUTS 



5. INPUTS 
OUTPUTS 



INPUTS 
OUTPUTS 



SAME AS EXAMPLE 1. EXCEPT B« 1 . . • 5 ) --21 . 1 t. 5, 0. , 4. 5,6. 
ICOUNTd.. ,6) =0,5,3,5,1,1 IANS=0 

SAME AS EXAMPLE 1. EXCEPT Bd . . . 5 ) =-21 . 1 1. 5, 0,4. 5, 6. 1 
ICOUNTd. ..6) =0,5,3,5,2,0 IANS=0 



SAME AS EXAMPLE 1. EXCEPT B(1)=0. B(2)=.5 
ICOUNTd. ..3) =8,1,6 IANS=0 

SAME AS EXAMPLE 4. EXCEPT LB=0 
ERROR IANS =2 



LB=2 



SAME AS EXAMPLE 4. 
ERROR IANS = 1 



EXCEPT LX=0 LB=2 



« SAVE 
FRQCT2 



STZCNT 
ENDi 
LOOP 



TESTLO 
BTEST1 



TESTHI 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 



IRS AND 


CHECK FOR ILLEGAL PARAMETERS 


0092 


PZE 


0 




0093 


BCI 


1,FRQCT2 




0094 


SXA 


RETURN, 1 




0095 


SXA 


RETURN+1,2 




0096 


SXA 


RETURN+2,4 




0097 


SXD 


FRQCT2-2,4 




0098 


STZ* 


6,4 


I ANS=0 


0099 


CLA* 


2,4 


GET LX 


0100 


TZE 


ERR1 




0101 


TMI 


ERRI 




0102 


STO 


END 




0103 


CLA« 


4,4 


GET LB 


0104 


TZE 


ERR2 




0105 


TMI 


ERR2 




0106 


ARS 


18 


LB IN ADDRESS 


0107 


STO 


LB 




0108 


ARS 


1 


LB/2 ( IN ADDRESS) 


0109 


STO 


LBHALF 




0110 


CLA 


lt4 


ADDRESS OF X 


0111 


ADO 


Kl ML I 


A(X+1) 


0112 


STA 


XADD 




0113 


STA 


TESTLO 




0114 


CLA 


3,4 


ADORESS OF B 


0115 


ADD 


K l ML I 


A(B+1) 


0116 


STA 


BTEST1 




0117 


STA 


BADD 




0118 


SUB 


LB 




0119 


STA 


TESTHI 




0120 


CLA 


5,4 


ADDRESS OF ICOUNT 


0121 


ADD 


K1MLI 


A( ICOUNT+1) 


0122 


STA 


STZCNT 




0123 


STA 


EQUAL 




0124 


STA 


STOCNT 




0125 


LXA 


LB, I 




0126 


TXI 


•♦1,1,1 




0127 


SXD 


ENDI, 1 




0128 


AXT 


1,4 




0129 


AXT 


1,1 




0130 


STZ 


»»,1 


ZERO ICOUNT( I ), I=1,LB+1 


0131 


TXI 


•♦it it 1 




0132 


TXL 


STZCNT, 1,#* 


**=LB^1 


0133 


AXT 


If 1 




0134 


CLA 


Kl ML I 




0135 


STO 


LBLO 


INITIAL LBL0=1 


0136 


CLA 


LB 




0137 


STO 


LBHI 


INITIAL LBHI=LB 


0138 


CLA 


LBHALF 




0139 


STO 


LBCOM 


INITIAL LBC0M=L8/2 


0140 


AXT 


lf2 




0141 


CLA 


*»,1 


GET X. <**=A(X+l)) 


0142 


CAS 


** ,4 


B(l) SEE IF IN LOWEST RANGE 


0143 


TRA 


TESTHI 




0144 


TRA 


NEXINO 




0145 


TRA 


EQUAL 




0146 


CAS 


** 


**=A(B(LB)>. SEE IF IN HIGHEST RANGE 


0147 


TRA 


HIEST 




0148 


TRA 


HI EST 




0149 
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SEARCH 


LXA 


LBCOM, 2 




0150 


XAOD 


CLA 


»*tl 


GET X(IR1) 


0151 


BADD 


CAS 


**,2 


COMPARE WITH B( LBCOM) 


0152 




TRA 


GRATER 


X GREATER, NEW LBLO (*LBCOM) 


0153 




TRA 


NEXIND 


GOT IT, INDEX IC0UNTUR2+1) 


0154 


LESS 


PXA 


0,2 


X LESS, NEW LBHI ( -LBCOM ) 


0155 




SUB 


LBLO 


LBCOM— LBLO-D IF 


0156 




CAS 


KIMLI 




0157 




TRA 


*+3 


DIF GREATER THAN ONE 


0158 




TRA 


EQUAL 


DIF=1, GOT IT, INDEX ICOUNTl IR2) 


0159 




TRA 


ERROR 


IMPOSSIBLE 


0160 




ARS 


1 


DIF/2 


0161 




ADO 


LBLO 


NEW LBCOM 


0162 




LOQ 


LBCOM 




0163 




STQ 


LBHI 




0164 




STO 


LBCOM 




0165 




TRA 


SEARCH 




0166 


GRATER 


PXA 


0,2 




0167 




SUB 


LBHI 


LBCOM-LBHI=-DIF 


0168 




SSP 




DIF 


0169 




CAS 


KIMLI 




0170 




TRA 


*+3 




0171 




TRA 


NEXIND 


GOT IT, INDEX ICOUNT( IR2+1) 


0172 




TRA 


ERROR 


IMPOSSIBLE 


0173 




ARS 


1 




0174 




ADD 


LBCOM 




0175 




LOO 


LBCOM 




0176 




STO 


LBCOM 




0177 




STQ 


LBLO 




0178 




TRA 


SEARCH 




0179 


NEXIND 


TXI 


♦♦1,2,1 




0180 


EQUAL 


CLA 


**,2 


**=A( ICOUNT+1) 


0181 




ADD 


KIFX 




0182 


STOCNT 


STO 


**,2 


**=A( ICOUNT+1) 


0183 




TXI 


•♦1,1,1 




0184 


ENO 


TXL 


L00P,1,*» 


**=LX 


0185 


RETURN 


AXT 


»*tl 




0186 




AXT 


*»,2 




0187 




AXT 


**,4 




0188 




TRA 


7,4 




0189 


HIEST 


LXA 


LB, 2 




0190 




TRA 


NEXIND 




0191 


ERR1 


CLA 


KIFX 




0192 




STO* 


6,4 




0193 




TRA 


7,4 




0194 


ERR2 


CLA 


K2FX 




0195 




STO* 


6,4 




0196 




TRA 


7,4 




0197 


ERROR 


CLA 


K3FX 




0198 




STO* 


6,4 




0199 




TRA 


7,4 




0200 


• CONSTANTS 


AND TEMPORARIES 




0201 


KIFX 


PZE 


0,0,1 




0202 


K2FX 


PZE 


0,0,2 




0203 


K3FX 


PZE 


0,0,3 




0204 


KIMLI 


PZE 


1,0,0 




0205 


LB 


PZE 


0 




0206 


LBHALF 


PZE 


0 




0207 


LBLO 


PZE 


0 




0208 


LBCOM 


PZE 


0 




0209 


LBHI 


PZE 


0 




0210 




END 






0211 
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* FSKIP ( SUBROUTINE ) 9/4/64 LAST CARD IN DECK IS NO. 0103 

* FAP 0001 
•FSKIP 0002 

COUNT 75 0003 

LBL FSKIP 0004 

ENTRY FSKIP ( ITAPEtNF ILES ) 0005 

* 0006 
» 0007 

« ABSTRACT 0008 

» 0009 

» TITLE - FSKIP 0010 

* SKIP FORWARD OR BACKWARD OVER FILES ON TAPE 0011 

* 0012 

* FSKIP SKIPS AN ARBITRARY NUMBER OF FILES FORWARD OR 0013 

* BACKWARD ON A TAPE. THE END POSITION OF THE TAPE IS 0014 
» AT THAT EDGE OF THE FILE MARK WHICH IS FURTHEST FROM 0015 

* THE BEGINNING OF THE TAPE. 0016 
» 0017 

* LANGUAGE - FAP, SUBROUTINE 4 FORTRAN II COMPATIBLE) 0018 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME, DATA CHANNEL AND TAPE UNIT) 0019 
» STORAGE - 50 REGISTERS 0020 

* SPEED - 0021 
» AUTHOR - J.F. CLAERBOUT, AUGUST, 1962 0022 

* 0023 

* 0024 

* USAGE 0025 

* 0026 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0027 

* AND FORTRAN SYSTEM ROUTINES - (IOS), CRDS), CBSR), <TC0), 0028 

* ( TEF ) , <TRC) 0029 

* FORTRAN USAGE 0030 

* CALL FSKIP ( I TAPE, NF ILES ) 0031 

* 0032 

* 0033 
» INPUTS 0034 

* 0035 

* ITAPE IS LOGICAL TAPE NUMBER 0036 

* IS FORTRAN II INTEGER 0037 

* 0038 

* NFILES IS NUMBER OF FILES TO BE SKIPPED. 0039 

* IF GRTHN 0 SKIPS AHEAD. 0040 
» IF LSTHN 0 BACKS UP NFILES (OR TO LOAD POINT, WHICHEVER 0041 

* COMES FIRST). IF THE TAPE IS PRESENTLY PART WAY THROUGH 0042 

* A FILE, IT COUNTS AS ONE FILE. 0043 

* A FILE IS DEFINED TO BE ARBITRARY NUMBER OF BCD OR 0044 

* BINARY RECOROS FOLLOWEO BY AN END OF FILE. 0045 

* IF *0 DOES NOT MOVE THE TAPE 0046 
« IS FORTRAN II INTEGER 0047 

* 0048 

* 0049 

* OUTPUTS THE TAPE IS MOVED 0050 

* 0051 

* 0052 

* PROGRAM FOLLOWS BELOW 0053 

* 0054 



BCI 


1, FSKIP 




0055 


FSKIP SXA 


SKIP9,4 




0056 


CLA* 


1,4 




0057 


STD 


SKIP3 




0058 


CAL 


SKIP3 




0059 


TSX 


$(I0S),4 




0060 


LXA 


SKIP9,4 




0061 


CAL* 


$(RDS) 


SET UP 


0062 


ANA 


=07000 




0063 


STA 


SKPBTi 


FOR BTT 


0064 


CLA* 


$(BSR) 




0065 


SSM 






0066 


STO 


SKPBSF 


SET UP BACKSPACE FILE INSTRUCTION. 


0067 


LDQ* 


$(TCO) 


SET UP 


0068 


SLQ 


SKIP4 


CHANNEL DELAY. 


0069 


SLQ 


SKIP5 




0070 


LDQ* 


$( TEF) 




0071 


SLQ 


SKPTEF 




0072 


SLQ 


A 




0073 


LDQ* 


$(TRC) 




0074 



FSKIP 
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SLQ 


TRC1 




0075 




CLA* 


2,4 




0076 




TZE 


3 t 4 


NO SKIPPING WANTED. 


0077 




PDX 


t4 


SET FOR N FILE JUMPS 


0078 




TPL 


SKIP1 


SKIP AHEAD ON TAPE. 


0079 


* 






SKIP BACK. 


0080 




XEC* 


$(BSR) 


GET OVER EOF MARK WHICH IS JUST BEFORE 


0081 


* 






PRESENT POSITION. 


0082 


SKPBSF 


BSFA 


• * 


GO BACK 


0083 




TIX 


*-1.4 f 1 


OVER N FILES. 


0084 




XEC* 


$<RDS) 


PASS OVER EOF 


0085 


SKIP4 


TCOA 


« 




0086 


A 


TEFA 


SKIP9 




0087 




XEC* 


$1 BSR) 


MUST BE AT BEGINNING OF TAPE 


0088 


SKPBTl 


BTT 


*» 


TURN OFF BEGINNING OF TAPE LIGHT. 


0089 




TRA 


SKIP9 


AT BEGINNING OF TAPE 


0090 


• DONE 


BACK 


SKIP 




0091 


• 








0092 


* DONE 


FORWARD SKIP 




0093 


SKIP1 


XEC* 


$(RDS) 


PASS A RECORD 


0094 


SKIP5 


TCOA 


« 


DELAY. 


0095 


SKPTEF 


TEFA 


SKIP2 


GO TO EOF COUNTER. 


0096 




TRA 


SKIP1 


NO EOF, KEEP PASSING RECORDS* 


0097 


SKIP2 


TIX 


SKIPl,4,l 


COUNT EOF*S. 


0098 


SKIP9 


AXT 


** ,4 




0099 


TRC1 


TRCA 


•♦1 




0100 




TRA 


3,4 




0101 


SKIP3 


PZE 


16 




0102 




END 






0103 
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* FT24 (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0847 

* f=AP 0001 
♦FT24 0002 

COUNT 750 0003 

LBL FT24 0004 

ENTRY FT24 (D,A,B) 0005 

» 0006 

* ABSTRACT 0007 

» 0008 

» TITLE - FT24 0009 

* HIGH SPEED 24 POINT SPECTRUM 0010 

* 0011 

* FT24 COMPUTES THE SINE AND COSINE TRANSFORMS OF 24 DATA 0012 

* POINTS, THE TRANSFORMS ARE EVALUATED AT FREQUENCIES 0013 

* 0014 

* FREQ ■= (I-i)*PI/12 1=1. ..13 0015 
» 0016 
» WHERE PI = 3.14159265 0017 

* AND FREQ = PI IS EQUIVALENT TO THE FOLDING FREQUENCY 0018 

* FOR THE DATA SERIES 0019 
» 0020 

* FT24 GAINS ITS SPEED FROM 0021 

* 0022 

* 1. STRAIGHT LINE PROGRAMMING RATHER THAN IN LOOPS 0023 

* 2. GROUPING TERMS TO MINIMIZE THE NUMBER OF MULTIPLIES 0024 

* NECESSARY 0025 

* 3. SUBGROUPING ADDITIONS TO TAKE ADVANTAGE OF VARIOUS 0026 
» SYMMETRIES 0027 

* 4. SELECTION OF THE NUMBER OF FREQUENCIES SO AS TO 0028 
» MAXIMIZE THE NUMBER OF SYMMETRIES GENERATED 0029 

* 5. USING FIXED POINT ARITHMETIC 0030 
» 0031 

* THE EQUATIONS USED WERE DEVELOPED IN SCIENTIFIC REPORT 0032 

* NO. 1 OF AIR FORCE CONTRACT AF 19(604)7378, APPENDIX J. 0033 

* 0034 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0035 

* EQUIPMENT - IBM 709 OR 7090 (MAIN FRAME ONLY) 0036 

* STORAGE - 777 REGISTERS 0037 

* SPEED - ABOUT 4750 MACHINE CYCLES. 0038 
» AUTHOR - CHEH PAN 0039 

* 0040 

* USAGE 0041 

» 0042 

» TRANSFER VECTOR CONTAINS ROUTINES - FXDATA, FLDATA 0043 

* AND FORTRAN SYSTEM ROUTINES - NONE 0044 

* 0045 

* FORTRAN USAGE 0046 

* CALL FT24 (D,A,B) 0047 

* 0048 

* INPUTS 0049 
» D(I) 1=1. ..24 IS THE DATA VECTOR THE TRANSFORM IS TO BE 0050 

* MADE OF. 0051 

* OUTPUTS 0052 

* All) 1=1... 13 IS THE COSINE TRANSFORM 0053 

* A(l) = (1/24) • (SUM (FROM 1*1 TO 24) OF D(I)) 0054 
» A(13)= (1/24) » (SUM (FROM 1*1 TO 24) OF 0055 
» D( I )*COS( ( 1-1 )*PI ) ) 0056 

* AU) = (1/12) * (SUM (FROM 1 = 1 TO 24) OF 0057 

* D( I )*COS( ( J-l)*( I-1MPI1) 005-8 
» FOR J = 2,3,..., 12 0059 

* 0060 

* B(I) 1=1... 13 IS THE SINE TRANSFORM 0061 
» B(l) = B(13) = 0.0 0062 

* B(J) = (1/12) * (SUM (FROM 1=1 TO 24) OF 0063 
» D(I)*SIN((J-1)»(I-1)»PIJ) 0064 

* FOR J = 2,3, ...,12 0065 

* 0066 

* EXAMPLES 0067 

* 0068 
« 1. INPUTS - DU...24) = 12.,12.,0.,0.,...,0. 0069 
» 0070 
» OUTPUTS - AU...13) = 1., 1.966, 1.866, 1.707, 1.500, 1.259, 1.000, 0071 

* 0.741,0.500,0.293,0.134,0.034,0.000 0072 



•»•*••••••****•»*•» PROGRAM LISTINGS *««»»*♦*•#•**#*#*••**«** 

FT24 » » FT24 » 



(PAGE 2) (PAGE 2) 

* 8(1. ..13) * 0. ,0.259,0.500,0.707,0.866,0.966,1.000, 0073 

* 0.966,0.866,0.707,0.500,0.259,0.000 0074 

* 0075 
HTR 0 0076 
BCI l,FT24 0077 

FT24 SXD *-2,4 0078 

CLA 1,4 0079 

ADD =HL 0080 

STA MOVED 0081 

CLA 2,4 0082 

ADD =1 0083 

STA MOVEA 0084 

CLA 3,4 0085 

ADD =1 0086 

STA MOVEB 0087 

* MOVE DATA INTO PROGRAM 0088 
AXT 24,4 0089 

MOVED CLA **,4 0090 

STO X0+l,4 0091 

TIX *-2,4,l 0092 

CALL FXDATA, KD24, XO , MX DAT A, SCALE 0093 

* INSERT INDIVIDUAL FORMULAE 0094 
CAO CLM 0095 

AXT 24,4 0096 

ADD X0+l,4 0097 

TIX *-l,4,l 0098 

STO AO 0099 

CA12 CLM 0100 

AXT 1,4 0101 

ADD X0+l,4 0102 

SUB X0,4 0103 

TXI *+l,4,2 0104 

TXL *-3,4,24 0105 

STO A12 0106 

CA1 CLA XO 0107 

SUB X12 0108 

STO Al 0109 

CLA XI 0110 

SUB Xll Olll 

SUB X13 0112 

ADD X23 0113 

XCA 0114 

MPY CI 0115 

ADD Al 0116 

STO Al 0117 

CLA X2 0118 

SUB X10 0119 

SUB X14 0120 

ADD X22 0121 

XCA 0122 

MPY C2 0123 

ADD Al 0124 

STO Al 0125 

CLA X3 0126 

SUB X9 0127 

SUB X15 0128 

ADD X21 0129 

XCA 0130 

MPY C3 0131 

ADD Al 0132 

STO Al 0133 

CLA X4 0134 

SUB X8 0135 

SUB X16 0136 

ADD X20 0137 

ARS 1 0138 

ADD Al 0139 

STO Al 0140 

CLA X5 0141 

SUB X7 0142 

SUB X17 0143 

ADD X19 0144 

XCA 0145 

MPY C5 0146 

ADD Al 0147 
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STO 


Al 


0148 


CLA 


X6 


0149 


SUB 


X18 


0150 


STO 


Bl 


0151 


CLA 


XI 


0152 


ADD 


Xll 


0153 


SUB 


Xi3 


0154 


SUB 


X23 


0155 


XCA 




0156 


MPY 


SI 


0157 


ADD 


Bl 


0158 


STO 


Bl 


0159 


CLA 


X2 


0160 


ADD 


X10 


0161 


SUB 


X14 


0162 


SUB 


X22 


0163 


ARS 


1 


0164 


AOO 


Bl 


0165 


STO 


Bl 


0166 


CLA 


X3 


0167 


A OD 


X9 


0168 


SUB 


X15 


0169 


SUB 


X21 


0170 


XCA 




0171 


MPY 


S3 


0172 


AOO 


Bl 


0173 


STO 


Bl 


0174 


CLA 


X4 


0175 


ADD 


X8 


0176 


SUB 


X16 


0177 


SUB 


X20 


0178 


XCA 




0179 


MPY 


S4 


0180 


ADD 


Bl 


0181 


STO 


81 


0182 


CLA 


X5 


0183 


ADD 


X7 


0184 


SUB 


X17 


0185 


SUB 


X19 


0186 


XCA 




0187 


MPY 


S5 


0188 


ADD 


Bl 


0189 


STO 


Bl 


0190 


CLA 


XO 


0191 


SUB 


X6 


0192 


ADD 


X12 


0193 


SUB 


X18 


0194 


STO 


A2 


0195 


CLA 


XI 


0196 


SUB 


X5 


0197 


SUB 


X7 


0198 


ADD 


Xll 


0199 


ADD 


X13 


0200 


SUB 


X17 


0201 


SUB 


X19 


0202 


ADD 


X23 


0203 


XCA 




0204 


MPY 


C2 


0205 


ADD 


A2 


0206 


STO 


A2 


0207 


CLA 


X2 


0208 


SUB 


X4 


0209 


SUB 


X8 


0210 


ADD 


X10 


0211 


ADD 


X14 


0212 


SUB 


X16 


0213 


SUB 


X20 


0214 


ADD 


X22 


0215 


ARS 


1 


0216 


ADD 


A2 


0217 


STO 


A2 


0218 


CLA 


X3 


0219 


SUB 


X9 


0220 


ADD 


X15 


0221 


SUB 


X21 


0222 
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CB3 



CA4 



STO 


B2 


CLA 


XI 


ADD 


X5 


SUB 


X7 


SUB 


Xll 


ADD 


X13 


ADD 


X17 


SUB 


X19 


SUB 


X23 


ARS 


1 


ADD 


B2 


STO 


B2 


CLA 


X2 


ADD 


X4 


SUB 


X8 


SUB 


XIO 


ADD 


X14 


ADD 


X16 


SUB 


X20 


SUB 


X22 


XCA 




MPY 


S4 


ADD 


B2 


STO 


B2 


CLA 


XO 


SUB 


X4 


ADD 


X8 


SUB 


X12 


ADD 


X16 


SUB 


X20 


STO 


A3 


CLA 


XI 


SUB 


X3 


SUB 


X5 


ADD 


X7 


ADD 


X9 


SUB 


Xll 


SUB 


X13 


ADD 


X15 


ADD 


X17 


SUB 


X19 


SUB 


X21 


ADD 


X23 


XCA 




MPY 


C3 


ADD 


A3 


STO 


A3 


CLA 


X2 


SUB 


X6 


ADD 


XIO 


SUB 


X14 


ADD 


X18 


SUB 


X22 


STO 


B3 


CLA 


XI 


ADD 


X3 


SUB 


X5 


SUB 


X7 


ADD 


X9 


ADD 


Xll 


SUB 


X13 


SUB 


X15 


ADD 


X17 


ADD 


X19 


SUB 


X21 


SUB 


X2 3 


XCA 




MPY 


S3 


ADD 


B3 


STO 


B3 


CLA 


XO 


SUB 


X3 


ADD 


X6 


SUB 


X9 


ADD 


X12 
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0223 
0224 
0225 
0226 
0227 
0228 
0229 
0230 
0231 
0232 
0233 
0234 
0235 
02 36 
0237 
0238 
0239 
0240 
0241 
0242 
0243 
0244 
0245 
0246 
0247 
0248 
0249 
0250 
0251 
0252 
0253 
0254 
0255 
0256 
0257 
0258 
0259 
0260 
0261 
0262 
0263 
0264 
0265 
0266 
0267 
0268 
0269 
0270 
0271 
0272 
0273 
0274 
0275 
0276 
0277 
0278 
0279 
0280 
0281 
0282 
0283 
0284 
0285 
0286 
0287 
0288 
0289 
0290 
0291 
0292 
0293 
0294 
0295 
0296 
0297 
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SUB 


XL5 


0298 


ADD 


XL8 


0299 


SUB 


X21 


0300 


STO 


A4 


0301 


CLA 


XI 


0302 


SUB 


X2 


0303 


SUB 


X4 


0304 


ADD 


X5 


0305 


ADD 


X7 


0306 


SUB 


X8 


0307 


SUB 


XIO 


0308 


ADD 


XI I 


0309 


ADD 


X13 


0310 


SUB 


X14 


0311 


SUB 


X16 


0312 


ADD 


X17 


0313 


ADD 


X19 


0314 


SUB 


X20 


0315 


SUB 


X22 


0316 


ADD 


X23 


0317 


ARS 


1 


0318 


ADD 


A4 


0319 


STO 


A4 


0320 


CLA 


XI 


0321 


ADD 


X2 


0322 


SUB 


X4 


0323 


SUB 


X5 


0324 


ADD 


X7 


0325 


ADD 


X8 


0326 


SUB 


XiO 


0327 


SUB 


Xll 


0328 


ADD 


X13 


0329 


ADD 


X14 


0330 


SUB 


Xi6 


0331 


SUB 


X17 


0332 


ADD 


X19 


0333 


ADD 


X20 


0334 


SUB 


X22 


0335 


SUB 


X23 


0336 


XCA 




0337 


MPY 


S4 


0338 


STO 


B4 


0339 


CLA 


XO 


0340 


SUB 


X12 


0341 


STO 


A5 


0342 


CLA 


X5 


0343 


SUB 


X7 


0344 


SUB 


X17 


0345 


ADD 


X19 


0346 


XCA 




0347 


MPY 


CI 


0348 


ADD 


A5 


0349 


STO 


A5 


0350 


CLS 


X2 


0351 


ADD 


XIO 


0352 


ADD 


X14 


0353 


SUB 


X22 


0354 


XCA 




0355 


MPY 


C2 


0356 


ADD 


A5 


0357 


STO 


A5 


0358 


CLS 


X3 


0359 


ADD 


X9 


0360 


ADD 


X15 


0361 


SUB 


X21 


0362 


XCA 




0363 


MPY 


C3 


0364 


ADD 


A5 


0365 


STO 


A5 


0366 


CLA 


X4 


0367 


SUB 


X8 


0368 


SUB 


X16 


0369 


ADD 


X20 


0370 


ARS 


I 


0371 


ADD 


A5 


0372 
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STO A5 0373 

CLA XI 0374 

SUB Xll 0375 

SUB X13 0376 

ADO X23 0377 

XCA 0378 

MPY C5 0379 

AOO A5 0380 

STO A5 0381 

CB5 CLA X6 0382 

SUB X18 0383 

STO B5 0384 

CLA X5 0385 

ADD X7 0386 

SUB X17 0387 

SUB X19 0388 

XCA 0389 

MPY SI 0390 

ADO B5 0391 

STO B5 0392 

CLA X2 0393 

ADD XIO 0394 

SUB X14 0395 

SUB X22 0396 

ARS 1 0397 

ADD B5 0398 

STO B5 0399 

CLS X3 0400 

SUB X9 0401 

ADD X15 0402 

ADD X21 0403 

XCA 0404 

MPY S3 0405 

ADD B5 0406 

STO B5 0407 

CLS X4 0408 

SUB X8 0409 

ADD X16 0410 

ADD X20 0411 

XCA 0412 

MPY S4 0413 

ADD B5 0414 

STO B5 0415 

CLA XI 0416 

ADD Xll 0417 

SUB X13 0418 

SUB X23 0419 

XCA 0420 

MPY S5 0421 

ADD B5 0422 

STO B5 0423 

CA6 CLA XO 0424 

SUB X2 0425 

ADD X4 0426 

SUB X6 0427 

ADD X8 0428 

SUB XIO 0429 

ADD X12 0430 

SUB X14 0431 

ADD X16 0432 

SUB X18 0433 

ADD X20 0434 

SUB X22 0435 

STO A6 0436 

CB6 CLA XI 0437 

SUB X3 0438 

ADD X5 0439 

SUB X7 0440 

ADD X9 0441 

SUB Xll 0442 

ADD X13 0443 

SUB X15 0444 

ADD X17 0445 

SUB X19 0446 

ADD X21 0447 
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CA7 



CB7 



SUB 


X23 


STO 


B6 


CLA 


XO 


SUB 


X12 


STO 


A7 


CLS 


X5 


AOD 


X7 


ADD 


XI7 


SUB 


X19 


XCA 




MPY 


CI 


ADD 


A7 


STO 


A7 


CLS 


X2 


ADD 


XIO 


ADD 


X14 


SUB 


X22 


XCA 




MPY 


C2 


ADD 


A7 


STO 


A7 


CLA 


X3 


SUB 


X9 


SUB 


X15 


ADD 


X21 


XCA 




MPY 


C3 


ADD 


A7 


STO 


A7 


CLA 


X4 


SUB 


X8 


SUB 


X16 


ADD 


X20 


ARS 


I 


ADD 


A7 


STO 


A7 


CLS 


XI 


ADD 


Xll 


ADD 


X13 


SUB 


X23 


XCA 




MPY 


C5 


ADD 


A7 


STO 


A7 


CLS 


X6 


ADD 


X18 


STO 


B7 


CLA 


X5 


ADD 


X7 


SUB 


X17 


SUB 


X19 


XCA 




MPY 


SI 


ADD 


B7 


STO 


B7 


CLS 


X2 


SUB 


XIO 


ADD 


X14 


ADD 


X22 


ARS 


1 


ADD 


B7 


STO 


B7 


CLS 


X3 


SUB 


X9 


ADD 


X15 


ADD 


X21 


XCA 




MPY 


S3 


ADD 


B7 


STO 


B7 


CLA 


X4 


ADD 


X8 


SUB 


X16 


SUB 


X20 


XCA 
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0448 
0449 
0450 
0451 
0452 
0453 
0454 
0455 
0456 
0457 
0458 
0459 
0460 
0461 
0462 
0463 
0464 
0465 
0466 
0467 
0468 
0469 
0470 
0471 
0472 
0473 
0474 
0475 
0476 
0477 
0478 
0479 
0480 
0481 
0482 
0483 
0484 
0485 
0486 
0487 
0488 
0489 
0490 
0491 
0492 
0493 
0494 
0495 
0496 
0497 
0498 
0499 
0500 
0501 
0502 
0503 
0504 
0505 
0506 
0507 
0508 
0509 
0510 
0511 
0512 
0513 
0514 
0515 
0516 
0517 
0518 
0519 
0520 
0521 
0522 
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MPY $4 0523 

ADD B7 0524 

STO B7 0525 

CLA XI 0526 

ADD XII 0527 

SUB X13 0528 

SUB X23 0529 

XCA 0530 

MPY S5 0531 

ADD B7 0532 

STO B7 0533 

CA8 CLA XO 0534 

ADD X3 0535 

ADD X6 0536 

ADD X9 0537 

ADD X12 0538 

ADD X15 0539 

ADD X18 0540 

ADD X21 0541 

STO A8 0542 

CLS XI 0543 

SUB X2 0544 

SUB X4 0545 

SUB X5 0546 

SUB X7 0547 

SUB X8 0548 

SUB XIO 0549 

SUB XI 1 0550 

SUB XI 3 0551 

SUB X14 0552 

SUB X16 0553 

SUB X17 0554 

SUB X19 0555 

SUB X20 0556 

SUB X22 0557 

SUB X23 0558 

ARS 1 0559 

ADD A8 0560 

STO A8 0561 

CB8 CLA Xi 0562 

SUB X2 0563 

ADD X4 0564 

SUB X5 0565 

ADD X7 0566 

SUB XB 0567 

ADD XIO 0568 

SUB Xll 0569 

ADD X13 0570 

SUB X14 0571 

ADD X16 0572 

SUB X17 0573 

ADD X19 0574 

SUB X20 0575 

ADD X22 0576 

SUB X23 0577 

XCA 0578 

MPY S4 0579 

STO B8 0580 

CA9 CLA XO 0581 

SUB X4 0582 

ADD X8 0583 

SUB X12 0584 

ADD X16 0585 

SUB X20 0586 

STO A9 0587 

CLS XI 0588 

ADD X3 0589 

ADD X5 0590 

SUB X7 0591 

SUB X9 0592 

ADD Xll 0593 

ADD X13 0594 

SUB X15 0595 

SUB X17 0596 

ADD XL9 0597 
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ADD 


X2 1 




SUB 


X2 3 




XCA 






MPY 


C3 




ADD 


A9 




STO 


A9 


C89 


CLS 


X2 




ADD 


X6 




SUB 


XI 0 




ADD 


X14 




SU8 


XI 8 




ADD 


X22 




STO 


B9 




CLA 


X I 




ADD 


X3 




SUB 


X5 




SUB 


XT 




ADD 


X9 




ADD 


XI 1 




SUB 


XI 3 




SUB 


XI 5 




ADD 


X17 




ADD 


XI 9 




SUB 


X2 1 




SUB 


X23 




XCA 






MPY 


S3 




ADD 


B9 




STO 


B9 


CAIO 


CLA 


XO 




SUB 


X6 




ADD 


XI 2 




SUB 


X 1 8 




STO 


Al 0 




n 

ULj 






ADD 


X5 




ADD 


X7 




SUB 


X 1 1 




SUB 


XI 3 




Ann 


All 




ADD 


X19 




SUB 


X2 3 




XCA 






MPY 


C2 




ADD 


A 10 




STO 


Al 0 




CLA 


X2 




SUB 


X4 




SUB 


X8 




ADD 


XI 0 




ADD 


XI 4 




SUB 


X16 




SUB 


X20 




ADD 


X22 




ARS 






ADD 


Al 0 




STO 


Al 0 


CB 10 


CLA 


X3 




SUB 


X9 




ADD 


X15 




SUB 


X21 




STO 


B 10 




CLA 


XI 




ADD 


X5 




SUB 


X7 




SUB 


Xll 




ADD 


X13 




ADD 


X17 




SUB 


X19 




SUB 


X23 




ARS 


1 




ADD 


BIO 




STO 


BIO 




CLS 


X2 




SUB 


X4 
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0598 
0599 
0600 
0601 
0602 
0603 
0604 
0605 
0606 
0607 
0608 
0609 
0610 
0611 
0612 
0613 
0614 
0615 
0616 
0617 
0618 
0619 
0620 
0621 
0622 
0623 
0624 
0625 
0626 
0627 
0628 
0629 
0630 
0631 
0632 
0633 
0634 
0635 
0636 
0637 
0638 
0639 
0640 
0641 
0642 
0643 
0644 
0645 
0646 
0647 
0648 
0649 
0650 
0651 
0652 
0653 
0654 
0655 
0656 
0657 
0658 
0659 
0660 
0661 
0662 
0663 
0664 
0665 
0666 
0667 
0668 
0669 
0670 
0671 
0672 
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AOD 


X8 




ADO 


X10 




SUB 


X14 




SUB 


X16 




ADO 


X20 




A 00 


X22 




XCA 






MPY 


S4 




ADD 


BiO 




STO 


BIO 


CAll 


CLA 


XO 




SUB 


X12 




STO 


All 




CLS 


XI 




ADO 


Xll 




ADD 


X13 




SUB 


X23 




XCA 






MPY 


CI 




ADD 


All 




STO 


Ail 




CLA 


X2 




SUB 


X10 




SUB 


X14 




ADD 


X22 




XCA 






MPY 


C2 




ADD 


All 




STO 


Ail 




CLS 


X3 




ADD 


X9 




ADD 


X15 




SUB 


X21 




XCA 






MPY 


C3 




ADD 


Ail 




STO 


All 




CLA 


X4 




SUB 


X8 




SUB 


X16 




ADD 


X20 




ARS 


1 




ADD 


All 




STO 


All 




CLS 


X5 




ADD 


X7 




ADD 


X17 




SUB 


X19 




XCA 






MPY 


C5 




ADD 


All 




STO 


All 


CBll 


CLS 


X6 




ADD 


X18 




STO 


Bli 




CLA 


XI 




ADD 


Xll 




SUB 


X13 




SUB 


X23 




XCA 






MPY 


SI 




ADD 


Bil 




STO 


Bll 




CLS 


X2 




SUB 


X10 




ADD 


X14 




ADD 


X22 




ARS 


1 




ADD 


Bll 




STO 


Bil 




CLA 


X3 




ADD 


X9 




SU8 


X15 




SUB 


X21 




XCA 
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0673 
0674 
0675 
0676 
0677 
0678 
0679 
0680 
0681 
0682 
0683 
0684 
0685 
0686 
0687 
0688 
0689 
0690 
0691 
0692 
0693 
0694 
0695 
0696 
0697 
0698 
0699 
0700 
0701 
0702 
0703 
0704 
0705 
0706 
0707 
0708 
0709 
0710 
0711 
0712 
0713 
0714 
0715 
0716 
0717 
0718 
0719 
0720 
0721 
0722 
0723 
0724 
0725 
0726 
0727 
0728 
0729 
0730 
0731 
0732 
0733 
0734 
0735 
0736 
0737 
0738 
0739 
0740 
0741 
0742 
0743 
0744 
0745 
0746 
0747 
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MPY 


S3 


0748 




ADD 


Bll 


0749 




STO 


Bll 


0750 




CLS 


X4 


0751 




SUB 


X8 


0752 




ADD 


X16 


0753 




ADD 


X20 


0754 




XCA 




0755 




MPY 


S4 


0756 




ADD 


Bll 


0757 




STO 


Bll 


0758 




CLA 


X5 


0759 




ADD 


X7 


0760 




SUB 


X17 


0761 




SUB 


X19 


0762 




XCA 




0763 




MPY 


S5 


0764 




ADD 


Bll 


0765 




STO 


Bll 


0766 




LDQ 


SCALE 


0767 




FMP 


= 12. 


0768 




STO 


SCALE 


0769 




CALL 


FLDATA,KD26, BO, SCALE 


0770 




LDQ 


AO 


0771 




FMP 


= .5 


0772 




STO 


AO 


0773 




LDQ 


A12 


0774 




FMP 


= .5 


0775 




STO 


A12 


0776 




AXT 


13,4 MOVE COEFS 


0777 




CLA 


A0+l,4 BACK TO MAIN 


0778 


MOVEA 


STO 


»*,4 


0779 




CLA 


BO+1,4 


0780 


MOVEB 


STO 


**,4 


0781 




TIX 


MOVEA-1,4,1 


0782 


SV4 


LXD 


FT24-2,4 


0783 




TRA 


4,4 


0784 


MXDATA 


PZE 


0,0,100000 


0785 


SCALE 


PZE 




0786 


K026 


PZE 


0,0,26 


0787 


KD24 


PZE 


0,0,24 


0788 


SI 


OCT 


102203734074 SIN (PI/ 12) 


0789 


S3 


OCT 


265011714631 SIN(PI/4) 


0790 


S4 


OCT 


335547535014 SIN(PI/3) 


0791 


S5 


OCT 


367215650717 SIN(5*PI/12) 


0792 


CI 


EQU 


S5 C0S(PI/2) 


0793 


C2 


EQU 


S4 C0S(PI/6) 


0794 


C3 


EQU 


S3 C0S(PI/4) 


0795 


C5 


EQU 


SI COS(5*PI/12) 


0796 


A12 


PZE 




0797 


All 


PZE 




0798 


AlO 


PZE 




0799 


A9 


PZE 




0800 


Ad 


PZE 




0801 


A7 


PZE 




0802 


A6 


PZE 




0803 


A5 


PZE 




0804 


A4 


PZE 




0805 


A3 


PZE 




0806 


A2 


PZE 




0807 


Al 


PZE 




0808 


AO 


PZE 




0809 


812 


PZE 


ALWAYS ZERO 


0810 


Bll 


PZE 




0811 


BIO 


PZE 




0812 


89 


PZE 




0813 


B8 


PZE 




0814 


87 


PZE 




0815 


86 


PZE 




0816 


B5 


PZE 




0817 


84 


PZE 




0818 


B3 


PZE 




0819 


82 


PZE 




0820 


81 


PZE 




0821 


80 


PZE 


ALWAYS ZERO 


0822 
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X23 


PZE 


X22 


PZE 


X21 


PZE 


X20 


PZE 


X19 


PZE 


X18 


PZE 


X17 


PZE 


X16 


PZE 


X15 


PZE 


X14 


PZE 


X13 


PZE 


X12 


PZE 


Xll 


PZE 


XIO 


PZE 


X9 


PZE 


X8 


PZE 


X7 


PZE 


X6 


PZE 


X5 


PZE 


X4 


PZE 


X3 


PZE 


X2 


PZE 


XI 


PZE 


xo 


PZE 




END 
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0823 
0824 
0825 
0826 
0827 
0828 
0829 
0830 
0831 
0832 
0833 
0834 
0835 
0836 
0837 
0838 
0839 
0840 
0841 
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♦ FT24 -II (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0146 

* LABEL 0001 
CFT24 -II 0002 

SUBROUTINE FT24 (DD,AA,BB) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - FT24 -II 0007 

C HIGH SPEED 24 POINT SPECTRUM 0008 

C 0009 

C FT24 COMPUTES THE SINE AND COSINE TRANSFORMS OF 24 DATA 0010 

C POINTS. THE TRANSFORMS ARE EVALUATED AT FREQUENCIES 0011 

C 0012 

C FREQ * (I-i)»PI/12 1=1... 13 0013 

C 0014 

C WHERE PI = 3.14159265 0015 

C AND FREQ » PI IS EQUIVALENT TO THE FOLDING FREQUENCY 0016 

C FOR THE DATA SERIES 0017 

C 0018 

C FT24 GAINS ITS SPEED FROM 0019 

C 0020 

C 1. STRAIGHT LINE PROGRAMMING RATHER THAN IN LOOPS 0021 



C 2. GROUPING TERMS TO MINIMIZE THE NUMBER OF MULTIPLIES 0022 



C NECESSARY 0023 

C 3. SUBGROUPING ADDITIONS TO TAKE ADVANTAGE OF VARIOUS 0024 

C SYMMETRIES. 0025 

C 4. SELECTION OF THE NUMBER OF FREQUENCIES SO AS TO 0026 

C MAXIMIZE THE NUMBER OF SYMMETRIES GENERATED 0027 

C 0028 

C THE EQUATIONS USED WERE DEVELOPED IN SCIENTIFIC REPORT 0029 

C NO. 1 OF AIR FORCE CONTRACT AF 19(604)7378, APPENDIX J. 0030 

C 0031 

C LANGUAGE - FORTRAN II SUBROUTINE 0032 

C EQUIPMENT - IBM 709 OR 7090 (MAIN FRAME ONLY) 0033 

C STORAGE - 818 REGISTERS 0034 

C SPEED - ABOUT 4100 MACHINE CYCLES. 0035 

C AUTHOR - R.A. WIGGINS JUNE, 1963 0036 

C 0037 

C USAGE 0038 

C 0039 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0040 

C AND FORTRAN SYSTEM ROUTINES - NONE 0041 

C 0042 

C FORTRAN USAGE 0043 

C CALL FT24 (DD,AA,BB) 0044 

C 0045 

C INPUTS 0046 

C DD(I) 1*1. ..24 IS THE DATA VECTOR THE TRANSFORM IS TO BE 0047 

C MADE OF. 0048 

C OUTPUTS 0049 

C AAU) 1*1... 13 IS THE COSINE TRANSFORM 0050 

C AA(1) * (1/24) * (SUM f FROM 1*1 TO 24) OF D( I )) 0051 

C AA(13)* (1/24) « (SUM (FROM 1*1 TO 24) OF 0052 

C D( I)*COS( ( I-1)*PI)) 0053 

C AAU) * (1/12) * (SUM (FROM 1*1 TO 24) OF 0054 

C D(I)*C0S((J-1)*(I-1)*PI1) 0055 

C FOR J * 2,3,..., 12 0056 

C 0057 

C BBU) 1 = 1.. .13 IS THE SINE TRANSFORM 0058 

C BB(1) * BB(13) * 0.0 0059 

C BBU) * (1/12) * (SUM (FROM 1*1 TO 24) OF 0060 

C D(I)*SIN(U-1)*(I-1)»PI)) 0061 

C FOR J * 2,3, ...,12 0062 

C 0063 

C EXAMPLES 0064 

C 0065 

C 1. INPUTS - DDU...24) * 12. , 12. ,0. , 0. , . . . , 0. 0066 

C 0067 

C OUTPUTS - AAU. ..13) = 1 . , 1. 966, 1. 866, 1. 707, 1. 500, 1. 259, 1 . 000, 0068 

C 0.741,0.500,0.293,0.134,0.034,0.000 0069 

C BB(1...13) * 0., 0.259, 0.500, 0.707, 0.866, 0.966, 1.000 0070 

C 0.966,0.866,0.707,0.500,0.259,0.000 0071 

C 0072 

C PROGRAM FOLLOWS BELOW 0073 

C 0074 
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DIMENSION DD<24) , AA( 13) ,BB( 13) , X { 24 ) , A< 13 ) , B ( 13) 0075 

EQUIVALENCE (X(l), XO ) , < X( 2) , XI ) , C X ( 3 ) , X2 ) , < X( 4 ) , X3 ) , < X < 5) , X4) 0076 

EQUIVALENCE (X ( 6 ) ,X5 ) , { X < 7 ) , X6 ) , ( X ( 8 ) , X7 ) , ( X C 9) , X8) , ( X< 10 ) , X9) 0077 

EQUIVALENCE < X ( 1 1 ) ,X 10 ) , < X C 12 ) ,X 1 1 ) , ( X ( 13 ) , X12» t < X < 14) , X13) 0078 

EQUIVALENCE ( X i 15) , X 14 ) f ( X ( 16 ) , X 15 ) , ( X < 17 ) ,X16) , < X{ 18) , X 17) 0079 

EQUIVALENCE ( X < 19) , X 18 ) , ( X i 20 ) , X19 ) , ( X < 21 ) , X20) , i X< 22 ) ,X2l ) 0080 

EQUIVALENCE ( X ( 23 ) , X22 ) , ( X ( 24 ) , X23 ) 0081 

EQUIVALENCE ( A ( 1 ) , AO ) , ( A( 2 ) , Al ) , ( A( 3) , A2) t ( A ( 4) , A3) , ( At 5 ) , A4) 0082 

EQUIVALENCE (A (6) , A5 ) , ( A ( 7 ) , A6) , ( A( 8 ) , A7 ) , < A( 9 ) , A8 ) , < A ( 10) • A9) 0083 

EQUIVALENCE ( A ( 1 1 ) t A 10 ) , ( A{ 12 ) , Al 1 ) , < A < 13 ) , A12 ) 0084 

EQUIVALENCE < B { 1 ) , BO ) , i B ( 2 ) , 81 ) , ( B ( 3 ) , B2) , < B( 4) , B3) , < B ( 5 ) t 64) 0085 

EQUIVALENCE ( B < 6 ) , 85 ) , ( B ( 7 ) , B6) , < B( 8 ) , B7 ) , ( B( 9 ) , 88) ♦ < B ( 10) , 89) 0086 

EQUIVALENCE i B ( 1 1 ) , BIO ) , ( B( 12) , Bl I ) , ( B( 13 ) , B 12 ) 0087 

EQUIVALENCE (C 1 , S5 ) , < C2, S4) f (C3 f S3 ) , < C5, SI ) 0088 

B Sl=177411017560 0089 

B S3=200552023632 0090 

B S4=200673317272 0091 

B S5=200756433522 0092 

A0=0. 0093 

DO 10 1=1,24 0094 

XU)=DDU)/12. 0095 

10 AO-AO+XU) 0096 

A0*A0/2. 0097 

A12=0. 0098 

DO 20 1=1,24,2 0099 

20 A12«A12+xm-X(I+l) 0100 

A12=Al2/2, 0101 

A1=(X0-X12)+(X1-X11-X13+X23)*C1+(X2-X10-X14+X22)»C2+ 0102 

1 (X3-X9-X15+X21 )*C3+(X4-X8-X16+X20)».5+CX5-X7-X17+X19)»C5 0103 

B1=(X6-X18) + (X1 + X11-X13-X23)*S1-MX2+X10-X14-X22)».5 + 0104 

1 (X3+X9-X15-X21)»S3+(X4+X8-X16-X20)*S44.(X5 + X7~X17-X19)»S5 0105 

A2=<X0-X6+X12~X18)+(X1-X5-X7+X11+X13-X17-X19+X23)*C2+ 0106 

1 (X2-X4-X8+X10+X14-X16-X20+X22)*.5 0107 

B2={X3-X9+X15-X21) + <XH-X5-X7-X1H-X13+X17-X19-X23)*.5*- 0108 

1 (X2+X4~X8-X10+X14+X16-X20-X22)*S4 0109 

A3=(X0-X4+X8-X12 + X16-X20) + (X1-X3-X5+X7+X9-X11-X13+X15+X17<-X19-X21* 0110 

1 X23)*C3 0111 

B3=(X2-X6+X10-X14+X18~X22)+(X1+X3-X5-X7+X9+X11-X13-X15+X17+X19-X21 0112 

1 -X23)*S3 0113 

A4=(X0-X3+X6-X9+X12-X15+X18-X21)+(X1-X2-X4+X5+X7~X8-X10+X11+X13- 0114 

1 X14-X16+X17+X19-X20-X22+X23)*.5 0115 

B4=(X1+X2~X4-X5+X7+X8-X10-X1H-X13+X14-X16-X17+X19+X20~X22~X23)»S4 0116 

A5=<XO-X12) + (X5-X7-X17+X19)*C1*(-X2+X10+X14-X22>»C2«- 0117 

1 (-X3+X9+X15-X21)*C3+( X4-X8-X 1 6+X20 ) *♦ 5+ ( X 1-X I 1-X 13+X23) *C5 0118 

B5=(X6-X18)+(X5+X7-X17~X19)*S1+(X2+X10-X14~X22)».5+ 0119 

1 <-X3-X9+X15+X21)*S3+(-X4-X8+Xl6+X20)*S4+< Xi+Xl 1-X13-X23 ) *S5 0120 

A6=(X0-X2+X4-X6+X8-X10+X12-X14+X16~X18+X20-X22) 0121 

B6=(X1-X3+X5~X7+X9-X11+X13-X15+X17-X19+X21-X23) 0122 

A7=(X0-X12)+(-X5+X7+X17-X19)*Cl+(-X2+X10+X14-X22)*C2+ 0123 

1 (X3-X9-X15+X21 )»C3MX4-X8-X16+X20)*.5+(-XH-Xll+X13-X23)*C5 0124 

B7=(-X6+X18)+<X5+X7-X17-X19)*Sl+(-X2-X10+X14+X22)*.5+ 0125 

1 <-X3-X9*X15+X21)*S3+(X4*X8-Xl6-X20)*S4+<Xl+Xll-X13-X23)*S5 0126 

A8=(X0+X3+X6+X9*X12+X15+X18+X21 )-(X 1+X2+X4+X5+X7+X8+X10+X11+X13+ 0127 

1 X14+X16+X17+X19+X20+X22+X23)».5 0128 

B8=(X1-X2+X4-X5+X7-X8+X10-X11+X13-X14+X16-X17+X19-X20+X22-X23)*S4 0129 

A9=(X0-X4+X8-Xl2+Xl6-X20) + (-Xl+X3+X5-X7-X9+Xll*X13-Xl5--Xl7+X19+ 0130 

I X21-X23)*C3 0131 

B9=(-X2+X6-X10+X14-X18+X22)+<X1+X3-X5~X7+X9+X11-X13-X15+X17+X19- 0132 

1 X21-X23)*S3 0133 

A10=<X0-X6+X12-X18)*(-XH"X5+X7-X11-X13+X17+X19-X23)»C2+ 0134 

1 (X2-X4-X8+X10+X14-X16-X20+X22)*.5 0135 

BIO = <X3-X94-X15-X21 ) ♦ < X 1+X5-X7-X 1 l+X 1 3+X1 7-X 19-X2 3 ) * . 5+ 0136 

1 (-X2-X4+X8+X10-X14-X16+X20+X22)*S4 0137 

Al 1= ( X0-X1 2 )+< -X1+X11+X13-X2 3 ) *Cl+( X2-X 10-X14+X 22 )»C2 + 0138 

I (-X3+X9+X15-X21)*C3+<X4-X8-X16+X20)*.5+(-X5+X7+X17-Xl9)*C5 0139 

Bll=(-X6+X18)+(Xl+Xll-X13~X23)*Sl+<-X2-X10+X14+X22)».5+ 0140 

I <X3+X9-X15-X21)*S3+(-X4-X8+X16+X20)*S4-MX5+X7-X17-Xl9)»S5 0141 

DO 30 1=1,13 0142 

AAU) = AU> 0143 

30 BB(I)«BU) 0144 

RETURN 0145 

END 0146 
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* FXDATA (SUBROUTINE) 10/1/64 LAST CARD IN DECK IS NO, 0247 

* FAP 0001 
•FXDATA 0002 

COUNT 230 0003 

LBL FXDATA 0004 

ENTRY FXDATA ( LX, X , MXDAT A, SCALE ) 0005 

ENTRY FLDATA (LX,X,SCALE) 0006 

* 0007 

» ABSTRACT 0008 

» 0009 

* TITLE - FXDATA WITH SECONDARY ENTRY FLDATA 0010 

* SCALE, CONVERT FLTG. VECTOR TO MACHINE INTEGERS OR CONVERSELY C011 

* 0012 
» FXDATA CONVERTS A FLOATING POINT VECTOR X(I) I=l.*.LX 0013 
» TO A MACHINE LANGUAGE INTEGER VECTOR (WITH BINARY POINT 0014 

* TO RIGHT OF BIT 35) IX C I ) 1=1. ..LX , SUCH THAT THE 0015 
» GREATEST MAGNITUDE OF IX = MXDAT A (AN INPUT PARAMETER). 0016 

* ROUNDING RATHER THAN TRUNCATION OCCURS IN THE CONVERSION. 0017 
» THE OUTPUT INTEGERS ARE NECESSARILY LESS THAN 2EXP17 0018 

* IN MAGNITUDE SINCE MXDATA IS A FORTRAN INTEGER. 0019 
» 0020 

* FLDATA PERFORMS THE INVERSE OF FXDATA. IT WILL HANOLE 0021 

* INTEGERS UP TO 2EXP35 - 1, HOWEVER. 0022 

* 0023 

* LANGUAGE - FAP SUBROUTINE (WITH FORTRAN II TYPE CALLING SEQUENCE) 0024 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0025 

* STORAGE - 102 REGISTERS 0026 
» SPEED - FXDATA TAKES ABOUT 38*LX MACHINE CYCLES 0027 

* FLDATA TAKES ABOUT 38*LX MACHINE CYCLES 0028 

* AUTHOR - S.M. SIMPSON 0029 
» 0030 

* USAGE OF FXDATA 0031 

* 0032 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0033 

* AND FORTRAN SYSTEM ROUTINES - NONE 0034 

* 0035 

* FORTRAN USAGE OF FXDATA 0036 

* CALL FXDATA(LX,X, MXDATA, SCALE) 0037 

* 0038 
« INPUTS TO FXDATA 0039 
» 0040 

* LX IS LENGTH OF X SERIFS 0041 
» IS A FORTRAN INTEGER WHICH MUST EXCEED ZERO 0042 

* 0043 

* X(I) 1=1,2,... ,LX IS A FLOATING POINT VECTOR 0044 

* 0045 
» MXDATA IS DESIRED MAXIMUM MAGNITUDE OF FIXED SERIES. 0046 

* IS A FORTRAN INTEGER WHICH MUST EXCEED ZERO 0047 

* 0048 

* OUTPUTS FROM FXDATA 0049 

* 0050 
» X(I) 1=1,2,... ,LX CONTAINS THE MACHINE LANGUAGE INTEGER 0051 

* VERSION OF THE INPUT SERIES, DEFINED BY 0052 
» X(I) = XF IXF ( X ( I )* SCALE ) 0053 
» WHERE 0054 

* SCALE = FLOATF ( MXDATA ) /XMAX 0055 

* XMAX = GREATEST MAGNITUDE OF ORIGINAL X(I) 0056 
» AND THE FUNCTION XFIXF(Y) IS EQUIVALENT TO 0057 

* 1. ROUND Y TO THE NEAREST FORTRAN INTEGER 0058 

* 2. SHIFT Y RIGHT ARITHMETICALLY 18 PLACES 0059 

* X(I) IS LEFT=0.0 IF XMAX IS FOUND = 0.0 0060 
» 0061 

* SCALE * FLOATF (MXDATA)/XMAX NORMALLY 0062 

* = -1.0 IF LX OR MXDATA IS ILLEGAL (X(I) LEFT AS IS) 0063 

* = -2.0 IF XMAX IS FOUND = 0.0 0064 
» 0065 

* FORTRAN USAGE OF FLDATA 0066 

* CALL FLDATA(LX,X, SCALE) 0067 
» 0068 

* INPUTS TO FLDATA 0069 

* 0070 
» LX IS LENGTH OF X SERIES 0071 
» IS A FORTRAN INTEGER WHICH MUST EXCEED ZERO 0072 

* 0073 

* X(I) 1=1.. .LX IS A SERIES CONSIDERED TO BE 35-BIT INTEGERS 0074 
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» PLUS SIGN (BINARY POINT TO RIGHT OF BIT 35) 0075 

* 0076 

* SCALE IS A FLOATING POINT SCALE FACTOR USED IN FLOATING XII) 0077 
» MUST EXCEED 0.0 0078 
» 0079 

* OUTPUTS FROM FLDATA 0080 

* 0081 

* XU) 1=1. ..LX IS THE FLOATED, SCALED FORM OF THE INPUT XU), 0082 

* XU) * FLOATF(X( I ) )/SCALE 0083 

* WHERE 0084 

* FLOATF { ) IS AN OPERATION WHICH CONVERTS ANY 0085 
» 36-BIT CONFIGURATION (CONSIDERED AS A 35-BIT 0086 

* PLUS SIGN INTEGER) TO A FLOATING POINT NUMBER 0087 
« HOWEVER X(I) IS LEFT UNDISTURBED IF EITHER 0088 
» 1. LX IS ZERO OR NEGATIVE 0089 

* OR 2* SCALE IS ZERO OR NEGATIVE 0090 

* 0091 

* EXAMPLES OF FXDATA 0092 

* 0093 

* 1. INPUTS - LX = 5 X(l...5)= 230. ,-400. , 57. ,-170. , 99, 8 MXDATA=10 0094 
» OUTPUTS - XU...5) = OCT 000000000006,400000000012,000000000001, 0095 
» 400000000004,000000000002 SCALE * 0.0250 0096 

* 0097 

* 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT LX*3 MXDATA*100 0098 
» OUTPUTS - XU...3) = OCT 000000000072,400000000144,000000000016 0099 

* SCALE = 0.250 0100 
» 0101 

* 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT LX = 1 0102 

* OUTPUTS - X(l) = OCT 000000000012 SCALE * 0.04347826 0103 

* 0104 
» 4. INPUTS - SAME AS EXAMPLE 1. EXCEPT X(l...5)= 0.,0. f ... 0105 

* OUTPUTS - X(1...5)= 0.,0.,... SCALE = -2.0 0106 

* 0107 

* 5. INPUTS - SAME AS EXAMPLE 1. EXCEPT MXDATA = -2 0108 

* OUTPUTS - XU...5) = SAME AS INPUT SCALE * -1.0 0109 
» 0110 

* 6. INPUTS - SAME AS EXAMPLE 1. EXCEPT LX = 0 0111 

* OUTPUTS - SAME AS EXAMPLE 5. 0112 
» 0113 
» EXAMPLES OF FLDATA (THE FIRST 4 BELOW ARC THE INVERSES OF THE FIRST 0114 

* FOUR EXAMPLES OF FXDATA) 0115 

* 0116 

* 1. INPUTS - LX=5 X(1...5) * OCT 000000000006,400000000012, 0117 

* 000000000001,400000000004,000000000002 SCALE*. 025 0118 

* OUTPUTS - XU...5) = 240.,-400.,40.,-l60.,80. 0119 

* 0120 
» 2. INPUTS - LX*3 XU...3) * OCT 000000000072,400000000144, 0121 

* 000000000016 SCALE = 0.250 0122 

* OUTPUTS - XU...3) = 232. ,-400. ,56. 0123 
» 0124 
» 3. INPUTS - LX=1 X(l) = OCT 000000000012 SCALE = 0.04347826 0125 

* OUTPUTS - X(l) = 230. 0126 

* 0127 
» 4. INPUTS - LX*5 XU...5) = OCT 000000000000,... SCALE = -2.0 0128 
» OUTPUTS - XU...5) = 0.0,... 0129 

* 0130 

* 5. INPUTS - LX= -3 XU...3) * l.,2.,3. SCALE - 3.4 0131 

* OUTPUTS - XU...3) = l.,2.,3. 0132 
» 0133 
» 6. INPUTS - LX=4 XU...4) = OCT 377777777777,001000000000, 0134 

* 112402762000,007346545000 SCALE * 1.0 0135 

* (IE X = 2EXP35-1,2EXP27,10EXP10,10£XP9) 0136 
» OUTPUTS - XU...4) = 34359738367.0,134217728.0,10000000000.0, 0137 
« 1000000000.0 0138 
« 0139 

HTR 0 0140 

HTR 0 0141 

BCI 1, FXDATA 0142 

FXDATA SXD FXDATA-3,1 0143 

SXD FXDATA-2,4 0144 

CLA 2,4 0145 

ADD Kl 0146 

STA Fl 0147 

STA F4 0148 

STA F7 0149 
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* GET 1 


N» CHECK IT, AND CHECK 


MXDATA. 




0150 




CLS 


KF1 






0151 




STO 


SCALE 






0152 




CLA* 


1,4 


SET N 




0153 




STO 


N 


IN IR1 




0154 




TZE 


F7A 






0155 




TMI 


F7 A 






0156 




CLA* 


3,4 






0157 




TMI 


F7A 






0158 




TZE 


F7A 






0159 




LXD 


N,l 






0160 




STZ 


TMAX 


STORE TRIAL 


MAX 


0161 


F 


CLA 


TMAX 


FIND 




0162 


Fl 


SBM 


** , I 


MAXIMUM 




0163 




TPL 


F3 


OF 




0164 


F2 


CAL* 


Fl 


ALL 




0165 




STO 


TMAX 


ABSOLUTE 




0166 


F3 


TIX 


F,l,l 


VALUES 




0167 


* CHECK FOR 


CASE ALL X(I)=0 






0168 




CLS 


KF2 






0169 




STO 


SCALE 






0170 




CLA 


TMAX 






0171 




TZE 


F7A 






0172 




CLA» 


3,4 


FLOAT MXDATA 




0173 




ARS 


18 






0174 




ORA 


ORF 






0175 




FAD 


ORF 






0176 




FDP 


TMAX 






0177 




XCA 








0178 


* 




FIXED DAT A=SCALE*FLOAT ING DATA 


0179 




STO 


SCALE 


SCALE=MAX OF 


FIXED DATA/MAX OF FLOATING DATA 


0180 




LXD 


N,l 


SET TO SCALE 


N QUANTITIES 


0181 


F4 


LDQ 


**,1 






0182 




FMP 


SCALE 


SCALE 




0183 




UFA 


ORF 






0184 




LRS 








0185 




ANA 


AN 






0186 




LLS 








0187 




RQL 


8 






0188 




RND 








0189 


F7 


STO 


**, I 






0190 




TIX 


F4,l,l 






0191 


F7A 


CLA 


SCALE 






0192 




STO* 


4,4 






0193 




LXD 


FXDATA-3,1 






0194 




TRA 


5,4 






0195 


TMAX 


PZE 








0196 


ORF 


OCT 


233000000000 






0197 


SCALE 


PZE 








0198 


AN 


OCT 


000000377777 






0199 


N 


PZE 








0200 


Kl 


PZE 


1 






0201 


KOOl 


OCT 


001000000000 






0202 


K266 


OCT 


266000000000 






0203 


TEMP 


PZE 


** 






0204 


TEMP2 


PZE 


•* 






0205 


KF1 


DEC 


1.0 






0206 


KF2 


DEC 


2.0 






0207 


* 


CALL 


FLDATA, N, DATA 


,SCALE 




0208 


FLDATA 


SXD 


FXDATA-3,1 






0209 




SXD 


FXDATA-2,4 






0210 




CLA* 


1,4 






0211 




TMI 


F14 






0212 




TZE 


F14 






0213 




STO 


N 






0214 




CLA 


2,4 






0215 




ADD 


Kl 






0216 




STA 


FIO 






0217 




STA 


Fll 






0218 




CLA* 


3,4 


GET SCALE 




0219 




TMI 


F14 






0220 




TZE 


F14 






0221 




STO 


SCALE 






0222 




LXD 


N,l 






0223 


FIO 


CLA 


**,1 


FLOAT 




0224 
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PROGRAM LISTINGS 



* FXDATA 



< PAGE 4) (PAGE 4) 

LAS KOOl 0225 

TRA Q 0226 

TRA Q 0227 

ORA ORE NUMBERS 0228 

FAD ORF 0229 

FDP SCALE 0230 

Fll STQ 0231 

TIX F10,l,l 0232 

F14 LXD FXDATA-3,1 0233 

TRA 4,4 0234 

* HANDLE BIG NUMBERS 0235 

Q LRS 27 0236 

STQ TEMP 0237 

ORA K266 0238 

FAD ORF 0239 

STO TEMP2 0240 

CLA TEMP 0241 

ARS 8 0242 

ORA ORF 0243 

FAD ORF 0244 

FAD TEMP2 0245 

TRA Fll-1 0246 

END 0247 
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* GENHOL ( SUBROUTINE ) 3/15/65 LAST CARO IN DECK IS NO. 0144 

* FAP 0001 
•GENHOL 0002 

COUNT 140 0003 

LBL GENHOL 0004 

ENTRY GENHOL (H0L1 0005 

* 0006 

« ABSTRACT 0007 

« 0008 

« TITLE - GENHOL 0009 

* GENERATE HOLLERITH FIELD 0010 
» 0011 

* GENHOL GENERATES THE HOLLERITH FIELD THAT WOULD HAVE BEEN 0012 

* PRINTED BY AN IMMEDIATELY SUCCEEDING PRINT STATEMENT. 0013 

* 0014 

* LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0015 
« EQUIPMENT - 709, 7090 (MAIN FRAME ONLY) 0016 
« STORAGE - 48 REGISTERS 0017 

* SPEED - 0018 
« AUTHOR - R.A. WIGGINS, NOV., 1962 0019 

* 0020 

« USAGE 0021 

« 0022 

« TRANSFER VECTOR CONTAINS ROUTINES - NONE 0023 

« AND FORTRAN SYSTEM ROUTINES - (IOH) 0024 

« 0025 

« FORTRAN USAGE 0026 

* CALL GENHOL (HOL) 0027 
« PRINT FMT, LIST 0028 

* 0029 
« INPUTS 0030 
» 0031 

* LIST IS A LIST OF VARIABLES FOR TRANSMISSION AS DEFINED IN 0032 

* THE FORTRAN REFERENCE MANUAL. 0033 
« 0034 
« FMT IS A STANDARD FORMAT ENTRY TELLING HOW THE LIST IS TO 0035 
« BE TRANSMITTED INTO HOLLERITH. THE FORMAT MAY IMPLY 0036 

* AN ARBITRARY NUMBER OF LINES OF PRINTED OUTPUT, BUT 0037 
« NONE OF THESE LINES MAY EXCEED 132 CHARACTERS. 0038 

* 0039 

* OUTPUTS 0040 
« 0041 

* HOL ( I ) 1=1. ..N IS THE HOLLERITH EQUIVALENT TO THE LINE(S) 0042 
« WHICH WOULD NORMALLY BE PRINTED BY THE PRINT STATEMENT. 0043 
« ACTUAL PRINTING DOES NOT OCCUR. 0044 
« 0045 

* LET NLINES = NO. OF LINES IMPLIED BY THE FORMAT 0046 

* NCU) = NO. OF CHARACTERS (INCLUDING SPACES) 0047 
« IMPLIED BY THE FORMAT FOR THE J-TH LINE 0048 
« NRU) * NO. OF REGISTERS OF HOL(I) WHICH WILL 0049 
« BE OCCUPIED BY THE CHARACTERS FOR THE 0050 
« J-TH LINE 0051 
« THEN 0052 

* NRU) « MAXIMUM(3, (NC(J)+5)/6 ) 0053 
» N = SUM(J=1... NLINES) OF NRU) 0054 

* H0L(1...NR(1)) HAS CHARACTERS FOR LINE 1 0055 
« (6 PER REGISTER, LEFT ADJUSTED) 0056 

* H0L(NR(1) + 1,...,NR(1HNR(2)) FOR LINE 2 0057 
» ETC. 0058 
« ALL SPARE CHARACTER POSITIONS IN HOL(I), IF ANY, 0059 
« WILL BE FILLED WITH BLANKS (OCTAL 60) 0060 
« 0061 
« EXAMPLES 0062 

* 0063 
« 1. EXAMPLE OF GENERATION OF HOLLERITH CHARACTERS WITH NO LIST. 0064 

* INPUTS - FMTU...7) = 6H(34H HOLLERITH CHARACTERS WITH NO LIST) 0065 
« USAGE - CALL GENHOL (HOL) 0066 

* PRINT FMT 0067 

* OUTPUTS - H0L(1...6) » 6H HOLLERITH CHARACTERS WITH NO LIST 0068 

* 0069 

* 2. EXAMPLE OF INSERTION OF A NUMBER FROM A LIST. 0070 
» INPUTS - FMTU...6) * 6H(25H BOMB SEISMIC RECORD NO. 14) 0071 
« LIST(l) » 42 0072 

* USAGE - CALL GENHOL (HOL) 0073 

* PRINT FMT, LIST(l) 0074 
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PROGRAM LISTINGS 



GENHOL 



( PAGE 2) 



• 


OUTPUTS 




HOL( 1. • 


.5) 


= 6H BOMB SEISMIC RECORD NO. 42 




0075 


• 














0076 




EXAMPLE 


OF GENERATION 


OF A VARIABLE FORMAT STATEMENT. 




0077 


* 


INPUTS 




FMT( I. • 


.5) 


= 6H(IH(I3,3HI7,I3,10HX,2H /2I4)) 




0078 


« 






LIST(l) 


* 5 


LIST(2) » 35 




0079 


* 


USAGE 




CALL 


GENHOL (HOL) 




0080 


« 






PRINT 


FMT, LISTI1), LISTC2) 




0081 


• 


OUTPUTS 




HOLU.. 


• 4) 


« 6H( 517, 35X,2H /2I4) 




0082 


* 














0083 


« 4. 


EXAMPLE 


OF REPEATED LINES. NOTE THAT THE MINIMUM LINE LENGTH 


IS 


0084 


• 


18 CHARACTERS. 








0085 


• 


INPUTS 


- 


FMT( 1. • 


.15) 


= 6H(24H1....6....12....18....24/18H1.... 




0086 


* 












0087 


« 










) 




0088 


« 


USAGE 


- 


CALL 


GENHOL (HOL) 




0089 


• 






PRINT 


FMT 




0090 


• 


OUTPUTS 


- 


HOL(l*. 


.22) 






0091 


• 














0092 


• 










1 




0093 


« 










1 




0094 


* 














0095 




HTR 




0 








0096 




BCI 




1, GENHOL 






0097 


GENHOL SXD 




•-2,4 




GET 




0098 




CAL 




1,4 




POSITION 




0099 




ADO 




= 1B35 








0100 




STA 




HOL 




OF HOL. 




0101 




SXA 




N,0 




RESET N COUNTER. 




0102 




CAL 




2,4 




CHECK FOR STANDARD ERROR PROCEDURE. 




0103 




ANA 




=0770377000000 




0104 




TZE 




NOERR 








0105 




CAL 




SSH 




NOT ZERO, STANDARD ERROR PRESENT. 




0106 




STA 




4,4 








0107 




TRA 




2,4 








0108 


NOERR CAL 




SSH 




ZERO, NO STANDARD ERROR PROCEDURE. 




0109 




STA 




2,4 








0110 




TRA 




2,4 








0111 


SSH 


PZE 




(SSH) 




STORAGE TO STORAGE HOLLERITH 




0112 


• 














0113 


* 






GHO - 


GENERATE HOLLERITH. 




0114 


(SSH) LDQ 




»+4 








0115 




CLA 




•♦2 








0116 




TRA» 




$( IOH) 








0117 




MZE 




,,3 








0118 




TRA 




GHO 








0119 


* 


REENTRY FROM (IOH). 




0120 


GHO 


SXA 




OUT, 4 




SAVE 




0121 




SXA 




oum,2 




INDEX 




0122 




SXA 




OUT+2,1 




REGISTERS. 




0123 




CAL 




1,4 




GET ADDRESS 




0124 




ARS 




18 








0125 




ADD 




1,4 








0126 




STA 




H0L1 




OF RECORD BEGINNING, 




0127 




PDX 




,2 




AND SAVE 




0128 




SXO 




A, 2 








0129 




SXO 




N+1,2 




LENGTH OF RECORD. 




0130 


N 


AXT 




•♦,1 




SET 




0131 




TXI 




»+l,l,» 


» 


INDEX COUNT 




0132 




SXA 




N,l 




FOR HOL. 




0133 




AXT 




1,2 








0134 


HOL1 CLA 




♦♦,2 








0135 


HOL 


STO 




*»,1 








0136 




TIX 




♦♦1,1,1 








0137 




TXI 




♦+1,2,1 








0138 


A 


TXL 




H0L1,2, 


• * 






0139 


OUT 


AXT 




**,4 








0140 




AXT 




♦♦,2 








0141 




AXT 




♦♦,1 








0142 




TRA 




2,4 








0143 




ENO 












0144 
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GETHOL » « GETHOL 



« GETHOL (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0175 

• LABEL 0001 

CGETHOL 0002 
SUBROUTINE GETHOL ( JOS , HARG, HOL , NCRS , I XCOM, ICOUNT) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - GETHOL 0007 

C GET HOLLERITH DATA FROM CALLING SEQUENCE 0008 

C 0009 

C GETHOL ASSUMES ONE OF ITS ARGUMENTS IS HOLLERITH OATA 0010 

C GENERATED IN THE CALLING SEQUENCE (STORED FAP-W1SE AND 0011 

C TERMINATED BY AN ALL-ONES FENCE). THEN, AT THE OPTION 0012 

C OF THE USER, IT EITHER 0013 

C 1. MOVES THE HOLLERITH TO AN OUTPUT ARGUMENT 0014 

C REVERSING THE STORAGE ORDER 0015 

C OR 0016 

C 2. REVERSES THE STORAGE ORDER OF THE HOLLERITH 0017 

C AT ITS PRESENT LOCATION (THE FENCE IS ALSO MODIFIED 0018 

C AS A FLAG SO THAT GETHOL WILL NOT RE-REVERSE THE 0019 

C DATA ON SUBSEQUENT CALLS FOR EITHER OPTION) 0020 

C IN EITHER CASE THE FENCE IS NOT PART OF THE NEW HOLLERITH 0021 

C VECTOR AND GETHOL RETURNS AS OUTPUTS THE NO. OF CHARACTERS 0022 

C IN THE NEW VECTOR (SIX TIMES VECTOR LENGTH) AND THE 0023 

C INDEX OF THIS VECTOR WITH RESPECT TO THE FORTRAN 0024 

C COMMON BLOCK. 0025 

C 0026 

C FOR OPTION 2. IT ALSO ADDS ONE TO AN OUTPUT COUNTER. 0027 

C 0028 

C LANGUAGE - FORTRAN II SUBROUTINE 0029 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0030 

C STORAGE - 169 REGISTERS 0031 

C SPEED - 0032 

C AUTHOR - S.M. SIMPSON, MARCH 1963 0033 

C 0034 

C US AGE — 0035 

C 0036 

C TRANSFER VECTOR CONTAINS ROUTINES - REVERS 0037 

C AND FORTRAN SYSTEM ROUTINES - XLOC 0038 

C 0039 

C FORTRAN USAGE 0040 

C CALL GETHOL( JOB, HARG, HOL, NCRS, IXCOM, ICOUNT) 0041 

C 0042 

C INPUTS 0043 

C 0044 

C JOB =0 SPECIFIES THAT USER WANTS OPTION 1. (SEE ABSTRACT) 0045 

C NOT* 0 SPECIFIES THAT USER WANTS OPTION 2. (SEE ABSTRACT) 0046 

C 0047 

C HARG(I) 1=1,0,-1,... ,~LH0L+2 CONTAINS THE LHOL WORDS OF 0048 

C HOLLERITH DATA TO BE ACQUIRED 0049 

C I=-LH0L+1 IS THE FENCE = OCT 777/77777777 (FIRST CALL) 0050 

C NOTES- 0051 

C IF GETHOL HAS BEEN CALLED BY THE SAME CALL 0052 

C STATEMENT PREVIOUSLY WITH JOB NOT- 0, THE 0053 

C FENCE WILL HAVE BEEN CHANGED TO = OCT 777777777776 0054 

C 0055 

C GETHOL CONSIDERS IT AN ERROR IF ONE OF THESE TWO 0056 

C TYPES OF FENCES DOES NOT OCCUR WITHIN 106 CELLS 0057 

C OF HARG(i) (635 IS THE MAX NO. CHARACTERS 0058 

C EXPRESSIBLE ON 9 CONTINUATION CARDS IN A 0059 

C CALL GETHUL STATEMENT). 0060 

C 0061 

C OUTPUTS 0062 

C 0063 

C HARG ( I ) 1=1 ,0,.. c-LHOL+l IS UNCHANGED IF JOB*0, OR IF 0064 

C FENCE * OCT 777777777776 0065 

C FOR JOB NOT= 0 ANO FENCE = OCT 777777777777 0066 

C HARG(l,0,...,-LH0L+2) IS REVERSED 0067 

C HARG ( -LHGL+ I ) = FENCE IS SET = OCT 777777777776 0068 

C 0069 

C HOL(I) 1*1.. .LHOL IS UNDISTURBED FOR JOB NOT= 0 0070 

C FOR JOB * 0 0071 

C HOL(I) = HARG(2-I) IF FENCE = OCT 777777777777 0072 

C HOL(I) = HARGC-LHOL + I + 1) IF FENCEOCT 777777777776 0073 

C 0074 
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* GETHOL * » GETHOL * 
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C NCRS IS THE NO. CHARACTERS OF HOLLERITH DATA « 6*LH0L 0075 

C IS SET = -1 IF LHOL EXCEEOS 106 0076 

C (NO OTHER OUTPUT IN THIS CASE) 0077 

C 0078 

C IXCOM IS THE INDEX WITH RESPECT TO COMMON OF THE NEW 0079 

C HOLLERITH VECTOR, I.E. THE INDEX OF HOL(l) OR 0080 

C OF HARG { -LH0L + 2 > WHICHEVER IS APPROPRIATE. 0081 

C 0082 

C ICOUNT IS NOT USED FOR OPTION I. 0083 

C IS INCREASED IN VALUE BY 1 FOR OPTION 2. 0084 

C 0085 

C EXAMPLES 0086 

C 0087 

C 1. USAGE WITH JOB=0, IGNORING THE IXCOM OUTPUT 0088 

C USAGE - DIMENSION HOL(IO) 0089 
C CALL GETH0L(0,18HFIRST, SECOND, THIRD, HOL, NCRS* IXCOM, 0090 

C I ICOUNT) 0091 

C OUTPUTS - HOL(l)= 6HFIRST, 0092 

C H0L(2)= 6HSEC0ND 0093 

C H0L(3)= 6H, THIRD NCRS=18 ICOUNT IS UNDISTURBED 0094 

C 0095 

C 2. SIMILAR TO 1. BUT USING THE IXCOM OUTPUT FEATURE 0096 

C USAGE - DIMENSION CM(2), HOL(IO) 0097 

C COMMON CM 0098 

C CALL GETHOL (0, 1 2HF I R ST, SECOND* HOL, NCRS, IXCOM, 0099 

C 1 ICOUNT) 0100 

C OUTPUTS - HOL(l) = CM< IXCOM) = 6HFIRST, 0101 

C H0L(2) = CMUXCOM+1) = 6HSEC0ND NCRS=12 0102 

C 0103 

C 3. USAGE WITH JOB NOT- 0 0104 

C INPUTS - SET ICOUNT=0 0105 

C USAGE - CALL GETHOL (1»8H(5X,3I5), DUMMY, NCRS, IXCOM, ICOUNT) 0106 

C CUTPUTS - NCRS=12 CM< IXCOM) = 6H(5X,3I CM( IXCOM + 1 ) = 2H5I 0107 

C CM(IXCOM-l) * 0CT777777777776 (THE NEW FENCE) 0108 

C IC0UNT=1 0109 

C 0110 

C 4. REPEATED USE OF SAME CALL STATEMENT WITH JOB NOT = 0 0111 
C USAGE - DIMENSION CM ( 2 ) , SPACE( 2, 4) , HOL ( 2 , 4 ) , JOB( 4) ,NCRS( 4) 0112 

C COMMON CM 0113 

C JOB(l) * 0 0114 

C J0B(2) = 1 0115 

C J0B(3) = 0 0116 

C J0B(4) = I 0117 

C ICOUNT=0 v 0118 

C DO 10 1=1,4 0119 

C CALL GETH0L(J0B(I),7H1234567,H0L(l,I),NCRS(I), 0120 

C 1 IXCOM, ICOUNT) 0121 

C SPACE(1,I) = CM(IXCOM) 0122 

C 10 SPACE(2,I) = CMUXCOM+l) 0123 

C OUTPUTS - HOL(i,l)=H0L(i,3)=SPACE(l,I) = 6H123456 FOR I»l,2,3,4 0124 

C H0L(2,1)=H0L(2, 3 ) =SP ACE ( 2, I ) * 1H7 FOR 1*1,2,3,4 0125 

C NCRS(I) =12 FOR 1=1,2,3,4 IC0UNT=2 0126 

C 0127 

C 5. ILLEGAL HOLLERITH DATA 0128 

C INPUTS - SPACEU...150) = 6H2 LONG 0129 

C USAGE - CALL GETHOL( JOB, SPACE( 150) , HOL, NCRS, IXCOM, ICOUNT) 0130 

C CUTPUTS - NCRS = -1 0131 

C 0132 

C PROGRAM FOLLOWS BELOW 0133 

C FALSE DIMENSIONS 0134 

DIMENSION ICM(2),CM(2),H0L(2) 0135 

COMMON ICM 0136 

EQUIVALENCE (CM, I CM) , ( FNCE1 , IFNCE 1 ) , ( FNCE2, IFNCE2) 0137 

B FNCE1=777777777777 0138 

B FNCE2=777777777776 0139 

LOCCOM=XLOCF(CM) 0140 

C SEARCH FOR FENCE, SETTING SWITCH FOR TYPE FOUND IF ANY 0141 

IXARG=L0CC0M-XL0CF(HARG)+1 0142 

DO 50 1=1,106 0143 

IXNXT=IXARG-I 0144 

NEXT=ICM( IXNXT) 0145 

IFSWCH=0 0146 

IF(NEXT-IFNCEl) 40,70,40 0147 

40 IFSWCH=i 0148 

IF(NEXT-IFNCE2) 50,70,50 0149 
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50 CONTINUE 0150 

C ILLEGAL IE FALLS THRU 50 0151 

NCRS*-1 0152 

GO TO 9999 0153 

C OK IF JUMPS HERE. FORK ON JOB 0154 

70 LHL=I 0155 

IFiJOB) 100,30,100 0156 

C FOR JOB=0 MOVE DATA, SET IXCOM, THEN GO CHECK REVERSAL 0157 

80 DO 85 1=1, LHL 0158 

IXNXT = I XARG-LHL+I 0159 

85 HOL(I)=CM(IXNXT) 0160 

I XCM=LOCCOM~XLOCF ( HOL > + 1 0161 

GO TO 110 0162 
C FOR JOB NOT=0 SET IXCOM, NEW FENCE, INDEX ICOUNT, THEN CHECK REVERSAL 0163 

100 IXCM=IXARG-LHL+1 0164 

CM(IXCM-1)=FNCE2 0165 

ICOUNT^ICOUNT+1 0166 

C CHECK REVERSAL. IF NOT GO EXIT 0167 

110 IF(IFSWCH) 9990,120,9990 0168 

C REVERSE 0169 

120 CALL REVERS ( LHL,CM( IXCM) ) 0170 

C EXIT SEQUENCE 0171 

9990 NCRS=*6*LHL 0172 

IXCOM=IXCM 0173 

9999 RETURN 0174 

END 0175 
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• GETROl ( SUBROUTINE ) 10/1/64 LAST CARD IN DECK IS NO. 0172 

* LABEL 0001 
CGETR01 0002 

SUBROUTINE GETRDl ( ITAPE, NX, IX, I ANS > 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - GETROl 0007 

C ACCESS ROUTINE FOR RAND CORP. MILLION RANDOM DIGITS FROM TAPE 0008 

C 0009 

C GETRDl FURNISHES THE NEXT NX SEQUENTIAL RANDOM DIGITS 0010 

C AS FIXED POINT INTEGERS FROM A SPECIFIED TAPE UNIT. 0011 

C 0012 

C THE TAPE UNIT CONTAINS THE MILLION DIGITS IN BCD FORM 0013 

C AS LOADED OFF-LINE FROM THE 200 CO CARDS CONTAINING THEM, 0014 

C EACH CARD WITH FORMAT ( 50 1 1 ) . GETRDl KEEPS A BUFFER OF 0015 

C LENGTH 50 TO PREVENT MISSING ANY DIGITS, BUT DOES NOT 0016 

C CHECK FOR THE POSSIBILITY THAT THE SUPPLY IS EXHAUSTED. 0017 

C 0018 

C LANGUAGE - FORTRAN II SUBROUTINE 0019 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME PLUS 1 TAPE UNIT) 0020 

C STORAGE - 229 REGISTERS 0021 

C SPEED - SLOW, SINCE TAPE IS BCD 0022 

C AUTHOR - S.M.SIMPSON JR. 0023 

C 0024 

C USAGE 0025 

C 0026 

C TRANSVER VECTOR CONTAINS ROUTINES - (NONE) 0027 

C AND FORTRAN SYSTEM ROUTINES - (TSH), (RTN) 0028 

C 0029 

C FORTRAN USAGE 0030 

C CALL GETRD1(ITAPE,NX,IX,IANS) 0031 

C 0032 

C INPUTS 0033 

C 0034 

C I TAPE IS THE LOGICAL TAPE NO. OF THE RANDOM DIGICS TAPE 0035 

C MUST LIE BETWEEN 1 AND 20 INCLUSIVE 0036 

C 0037 

C NX IS THE DESIRED NO. OF DIGITS 0038 

C MUST EXCEED ZERO 0039 

C 0040 

C OUTPUTS 0041 

C 0042 

C IX(I) 1=1. ..NX WILL CONTAIN THE NEXT NX DIGITS AS FORTRAN 0043 

C FIXED POINT INTEGERS 0044 

C 0045 

C I ANS « 0 NORMAL 0046 

C = -1 FOR ILLEGAL ITAPE 0047 

C = -2 FOR ILLEGAL NX 0048 

C 0049 

C EXAMPLES 0050 

C 0051 

C 1. ILLUSTRATING EFFECTS OF SUCCESSIVE CALLS 0052 

C INPUTS - THE FIRST THREE RANO DIGITS CARDS ARE AS FOLLOWS 0053 

C 0054 

C C COLUMN NUMBERS 0055 

C A 0056 

C R 00000000011111111112222222222333333333344444444445 0057 

C D 12345678901234567890123456789012345678901234567890 0058 

C 0059 

C 1 10097325337652013586346735487680959091173929274945 0060 

C 2 37542048056489474296248052403720636104020082291665 0061 

C 3 08422689531964509303232090256015953347643508033606 0062 

C ASSUME THE CARDS ARE LOADED ON LOGICAL TAPE 9 0063 

C 0064 

C USAGE - REWIND 9 0065 

C CALL GETRDK9, 10,1X1, IANS1) 0066 

C CALL GETRD1(9,10,IX2,IANS2) 0067 

C CALL GETRDl (9, 1,IX3,IANS3) 0068 

C CALL GETRD1(9,29, IX4,IANS4) 0069 

C CALL GETRDl (9, 1,IX5,IANS5) 0070 

C CALL GETRD1(9,55,IX6,IANS6) 0071 

C REWIND 9 0072 

C CALL GETRDl (9, 3,IX7,IANS7) 0073 

C 0074 
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C OUTPUTS - IANS1=IANS2 * ETC * IANS7 * 0 (NO ILLEGAL IT IES) 0075 

C 1X1(1.*. 10) = 1,0,0,9, 7,3, 2 f 5,3,3 0076 

C 1X2(1.*. 10) * 7,6,5,2,0,1,3,5,8,6 0077 

C 1X3(1. ..1) » 3 0078 

C IX4(1.*.29) = 4,6,7,3,5,4,8,7,6,8,0,9,5,9,0,9,1,1,7,3, 0079 

C 9,2,9,2,7,4,9,4,5 0080 

C 1X5(1.^.1) = 3 0081 

C 1X6(1. ..55) = 7,5,4,2,0,4,8,0,5,6,4,8,9,4,7,4,2,9,6,2, 0082 

C 4,8,0,5,2,4,0,3,7,2,0,6,3,6,1,0,4,0,2,0, 0083 

C 0,8,2,2,9,1,6,6,5,0,8,4,2,2,6 0084 

C 1X7(1.*. 3) = 8,9,5 ( NOT = 1,0,0 SINCE GETRDi STILL 0085 

C HAS 44 DIGITS IN ITS BUFFER TO 0086 

C USE UP BEFORE READING FROM TAPE 0087 

C AGAIN) 0088 

C 0089 

C 2. ILLUSTRATING ILLEGAL USAGE 0090 

C 0091 

C USAGE - CALL GETRDK 0, 1, IX, I ANSI ) 0092 

C CALL GETR01(21,1, IX, IANS2) 0093 

C CALL GETRDH9,-3, IX, IANS3) 0094 

C 0095 

C OUTPUTS - IANS1 * I ANS2 * -1 (ILLEGAL ITAPE) 0096 

C IANS3 = -2 (ILLEGAL NX) 0097 

C 0098 

C PROGRAM FOLLOWS BELOW 0099 

C 0100 

C OUMMY DIMENSION STATEMENT 0101 

DIMENSION IX(2) 0102 

C TRUE DIMENSION STATEMENT 0103 

DIMENSION INP(50) 0104 

C CHECK LEGALITIES OF I TAPE, NX 0105 

IANS=-1 0106 

IF (ITAPE) 9999,9999,2 0107 

2 IF (ITAPE-20) 4,4,9999 0108 

4 I ANS=-2 0109 

IF (NX) 9999,9999,10 0110 

10 I0UT*0 0111 

IANS*0 0112 

MORE-NX 0113 

C 0114 

C ANY DIGITS LEFT IN BUFFER FROM PREVIOUS CALL (IF NO, GO READ 0115 

C 50 DIGITS). 0116 

C 0117 

IF ( NBUF ) 20,40,20 0118 

C 0119 

C IF YES, CHECK IF REQUEST CAN BE FILLED FROM BUFFER. 0120 

C 0121 

20 IF (NX-NBUF) 30,30,24 0122 

C 0123 

C IT CANT. EMPTY BUFFER AND THEN GO READ MORE DIGITS. 0124 

C 0125 

24 DO 26 1=1, NBUF 0126 

26 IX(I)=INP(I) 0127 

I0UT=N8UF 0128 

MORE^MORE-NBUF 0129 

GO TO 40 0130 

C 0131 

C IT CAN BE FILLED FROM BUFFER. SET UP TO DO SO AND EXIT. 0132 

C 0133 

30 NBL0K=NBUF 0134 

GO TO 66 0135 

C 0136 

C READ 50 DIGITS 0137 

C 0138 

40 READ INPUT TAPE IT APE, 42, < I NP (I), 1=1, 50) 0139 

42 FORMAT (5011) 0140 

C 0141 

C CHECK IF THIS IS LAST BLOCK OF 50 NEEDED. 0142 

C 0143 

IF (MORE-50) 60,60,50 0144 

C 0145 

C NO. MOVE BLOCK OF 50 AND GO BACK FOR ANOTHER. 0146 

C 0147 

50 DO 54 1=1,50 0148 

II=I+I0UT 0149 
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54 IXUI)*INPU) 
IOUT=IOUT+50 
MORE=MGRE-50 
GO TO 40 

C 

C YES» SET FOR FINAL MOVE. 
C 

60 NBL0K*50 

C 

C MOVE FINAL BLOCK AND SET UP BUFFER FOR NEXT CALL 
C 

66 00 68 I=1,M0RE 

II = H»IQUT 
68 IX(II) = INPU> 

NBUF-NBLOK-MORE 

IF { NBUF ) 70*9999,70 
70 MRP1=M0RE+1 

DO 74 I=MRP1,NBLQK 

II*I-MORfc 
74 INPUD^INPU) 

GO TO 9999 
9999 RETURN 

END 



* GETRD1 » 



(PAGE 3) 

0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
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GETX * * GETX * 



GETX (FORTRAN FUNCTION) 
FAP 



9/4/64 LAST CARD IN DECK IS NO. 



♦ GETX 



COUNT 
LBL 
ENTRY 
ENTRY 



100 
GETX 
GETX 
IGETX 



(X, 11,12,..., IN) 
(IX, II, 12,..., IN) 



» ABSTRACT 

• 

• TITLE - GETX WITH SECONDARY ENTRY POINT IGETX 

• ALLOWS VARIABLE DEPTH INDEXING OF VECTORS 
• 

• GETX IS A VARIABLE LENGTH CALLING SEQUENCE PROGRAM THAT 

• GETS A NUMBER BY MEANS OF A CHAIN OF INDEX VALUES. 

• THUS, THE STATEMENT 
• 

• XI * GETX (X,I1,I2) 
* 

• IS EQUIVALENT TO THE FORTRAN STATEMENTS 



Jl 
XI 



11(12) 
X( Jl) 



« LANGUAGE 

* EQUIPMENT 

* STORAGE 

• SPEED 

• AUTHOR 



IGETX PERFORMS THE SAME FUNCTION AS GETX. 
FAP (FORTRAN II FUNCTION) 

709 OR 7090 (MAIN FRAME AND SENSE INDICATORS ONLY) 
31 REGISTERS 

(1+N)*19 MACHINE CYCLES WHERE N=NUMBER OF ARGUMENTS 
R.A. WIGGINS, OCTOBER, 1963 



USAGE 



TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 
AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 



FORTRAN USAGE OF GETX 

XI = GETX (X, II, 12,..., IN) 



INPUTS 
X(I) 

IKI) 

12(1) 



* IN 

* OUTPUTS 
* 

» XI 



1=1,... ,LX IS A VECTOR OF VALUES. LX SHOULD BE GREATER 
THAN ANY OF THE INDICES IN THE INDEX VECTOR II* 

I = 1,...,LI1 IS A VECTOR OF INDICES. LU SHOULD BE 
GREATER THAN ANY OF THE INDICES IN THE VECTOR 12. 

IS SIMILAR TO II. 



IS AN INDEX VALUE. 



IS NUMBER AS DESCRIBED IN THE ABSTRACT. 



* FORTRAN USAGE OF IGETX 

* 1X1 = IGETX (IX, II, 12,..., IN) 
* 

* INPUTS AND OUTPUTS ARE ANALOGOUS TO GETX BUT FIXED POINT . 



* EXAMPLES 



0127 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
006 7 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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* 1. 


INPUTS 


- XU...5) = 


I. ,2., 


3. ,4. ,5. 


IX ( 1 . . 


.5) « i,2 t 3,4,5 


0075 


• 




11=4 












0076 


* 


USAGE 


XI = 


GETX 


<x,in 








0077 


* 




1X1= 


IGETX 


( IX, 11) 








0078 


• 


OUTPUTS 


- Xl = 4. 1X1= 


4 










0079 


* 
















0080 


• 2. 


INPUTS 


- SAME AS EXAMPLE 1 


. EXCEPT 






0081 


• 




11(1. ..7) = 


4,1,1 


,3,5,2, 


1 






0082 


• 




12(1. .*3) = 


1,7,5 


13 


ar 


3 




0083 


• 


USAGE 


XI = 


GETX 


(X,I1, 


12 


,13) 




0084 


* 




1X1 = 


IGETX 


( IX, 11, 


12 


,13) 




0085 


• 


OUTPUTS 


- Xl=5. 1X1= 


5 










0086 


* 
















0087 


• 
















0088 


• 
















0089 


* PROGRAM FOLLOWS BELOW 












0090 


» 
















0091 


XR4 


HTR 


0 












0092 


XR1 


HTR 


0 












0093 




BCI 


l.GETX 












0094 


GETX 


BSS 


0 












0095 


I GETX SXD 


XR4,4 












0096 




SXD 


XRl, 1 












0097 




STI 


IND 












0098 




SXD 


GETE, 4 












0099 


* FIND LAST 


ARGUMENT 












0100 


FIAT 


LDI 


1,4 












0101 




RIS 


MASK1 












0102 




OFT 


CTSXZ 












0103 


SWCH 


TXI 


OUT, 4,1 












0104 




TIX 


FIAT, 4,1 












0105 


» GET 


NUMBER 














0106 


OUT 


AXT 


0,1 












0107 




SXD 


XR41,4 












0108 


GET 


CLA 


1,4 












0109 




STA 


♦ ♦1 












0110 




CLA 


**,1 












0111 




PDX 


f 1 












0112 




TIX 


♦♦2,1,1 












0113 




AXT 


0,1 












0114 




TXI 


*+l,4,l 












0115 


GETE 


TXL 


GET,4,*» 


»* 


CONTAINS 


INITIAL 


XR4 


0116 


* LEAVE 














0117 




LDI 


IND 












0118 




LXD 


XRl,i 












0119 




LXD 


XR41,4 












0120 




TRA 


2,4 












0121 


IND 


PZE 














0122 


MASK1 OCT 


000000077777 










0123 


CTSXZ OCT 


770377700000 










0124 


MASK2 OCT 


000000177777 










0125 


XR41 


PZE 














0126 




END 
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♦ GNFLTl (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO* 0163 

• LABEL 0001 
CGNFLT1 0002 

SUBROUTINE GNFLTl ( AMSPEC, LSPEC, FLTR, I ANS ) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - GNFLTl 0007 

C GENERATE SYMMETRICAL FILTER WITH GIVEN AMPLITUDE RESPONSE 0008 

C 0009 

C GNFLTl GENERATES A SYMMETRICAL (TWO-SIDED) SET OF FILTER 0010 

C COEFFICIENTS WHOSE AMPLITUDE SPECTRUM APPROXIMATES A 0011 

C GIVEN AMPLITUDE SPECTRUM AT EQUALLY SPACED POINTS BETWEEN 0012 

C ZERO AND PI (RADIANS). IF THE DESIRED AMPLITUDE SPECTRUM 0013 

C IS AMP(I) I=0,1,...,M , THEN THE FILTER COEFFICIENTS, 0014 

C FILTER ( I ) I=-M,-M+1,...,M , ARE GENERATED BY A WEIGHTED 0015 

C ADDITION OF A SMOOTHED ORTHONORMAL SET OF OPERATORS 0016 

C ACCORDING TO 0017 

C M 0018 

C FILTER(S) = SUM < AMP( P ) *ORTNRM( S,P,M ) ) 0019 

C P=0 0020 

C FOR S = -M,...,M 0021 

C WHERE 0022 

C ORTNRM(S,P,M) = NRM( P , M ) *ORT ( S , P, M ) 0023 

C NRM(P,M) = 1/M FOR P = l,2,...,M-l 0024 

C NRM( P , M ) = 1/2M FOR P * 0 AND P * M 0025 

C AND 0026 

C ORT(S,P,M) * C(S)*((.54+.46*C0S(S»PI/M))*C0S(S»P*PI/M)) 0027 

C CCS) = 0.5 FOR S = M AND S = ~M 0028 

C C(S> = 1.0 OTHERWISE 0029 

C PI 3.14159265 0030 

C 0031 

C THE ORT(S,P,M) SET IS A SCALED VERSION OF THE ORTHONORMAL 0032 

C SET GIVEN BY TUKEY AND HAMMING (1949, MEASURING NOISE 0033 

C COLOR, BELL TEL. LAB. MEMO - MM-49-110-119. I 0034 

C 0035 

C LANGUAGE - FORTRAN II SUBROUTINE 0036 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0037 

C STORAGE - 232 REGISTERS 0038 

C SPEED - 0039 

C AUTHOR - S.M. SIMPSON JR. 0040 

C 0041 

C USAGE 0042 

C 0043 

C TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0044 

C AND FORTRAN SYSTEM ROUTINES r COS 0045 

C 0046 

C FORTRAN USAGE 0047 

C CALL GNFLTl ( AMSPEC ,LSPEC, FLTR, I ANS ) 0048 

C 0049 

C INPUTS 0050 

C 0051 

C AMSPECU) 1 = 1,... ,LSPEC CONTAINS THE DESIRED AMPLITUDE RESPONSE 0052 

C AMP(J) J=0,l,...,M (M=LSPEC-1) , I.E. 0053 

C AMSPECU) * AMP(I-l) * RESPONSE AT (I~1)*PI/M RADIANS 0054 

C AMSPEC(I) MUST NOT VANISH FOR ALL I VALUES 0055 

C 0056 

C LSPEC MUST EXCEED 2 AND BE LESS THAN OR * 1001 0057 

C 0058 

C OUTPUTS 0059 

C 0060 

C FLTR ( I ) 1=1,2,..., (2*M+1) ARE THE DESIRED FILTER COEFFICIENTS, 0061 

C FILTER(J) J= -M,-M+1,...,M , AS DEFINED IN ABSTRACT, 0062 

C I.E. FLTR ( I ) = F ILTER ( I— M-l ) 0063 

C 0064 

C IANS = 0 NORMALLY 0065 

C * -1 FOR ILLEGAL AMSPEC (ALL ZERO) 0066 

C = -2 FOR ILLEGAL LSPEC 0067 

C 0068 

C EXAMPLES 0069 

C 0070 

C 1. A NARROW LOW-PASS AND NARROW BAND-PASS FILTER 0071 

C INPUTS - Aid. ..21) ^ l.,0.,0.,...,0., LI = 21 0072 

C A2(1...2l) * 0.,0.,1.,0.,...0. L2 = 21 0073 

C USAGE - CALL GNFL Tl ( Al ,L 1 , FLTR 1 , IANS 1 ) 0074 



*»••»•»••*»••••••*»•**•• PROGRAM LISTINGS **«*•*»»*»# 

* GNFLTl * » GNFLT1 



(PAGE 2) (PAGE 2) 

C CALL GNFLT1(A2,L2,FLTR2, IANS2) 0075 

C OUTPUTS - IANS1 « IANS2 =0 0076 

C FLTRK 1...41) = 0077 

C .00100 .00214 .00257 .00326 .00420 0078 

C .00537 .00674 .00828 .00995 .01170 0079 

C .01350 .01530 .01706 .01872 .02026 0080 

C .02163 .02281 .02375 .02444 .02486 0081 

C .02500 .02486 .02444 .02375 .02281 0082 

C .02163 .02026 .01872 .01706 .01530 0083 

C .01350 .01170 .00995 .00828 .00674 0084 

C .00537 .00420 .00326 .00257 .00214 .00100 0085 

C FLTR2(1...41) = 0086 

C .00200 .00408 .00415 .00383 .00260 0087 

C .00000 -.00417 -.00974 -.01610 -.02226 0088 

C -.02700 -.02910 -.02760 -.02201 -.01252 0089 

C .00000 .01410 .02792 .03954 .04729 0090 

C .05000 .04729 .03954 .02792 .01410 0091 

C .00000 -.01252 -.02201 -.02760 -.02910 0092 

C -.02700 -.02226 -.01610 -.00974 -.00417 0093 

C .00000 .00260 .00383 .00415 .00408 .00200 0094 

C 0095 

C 2. TEST CASE FOR WHITE LIGHT FILTER (FILTER SHOULD 8E AN IMPULSE) 0096 

C INPUTS - AU...11) = l.,l.,...,l. L » 11 0097 

C USAGE - CALL GNFLT 1 ( A , L, FLTR, I ANS ) 0098 

C OUTPUTS - FLTR(1...21) = 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 1. ,0. , . . . 1 0. 0099 

C 0100 

C 3. ILLEGAL CONDITIONS 0101 

C INPUTS - Ad. ..5) , 0.,0.,0.,0.,0. 8(1. ..5) » 1., 1. , 1. , 1. , 1. 0102 

C USAGE - CALL GNFLTl ( A,5»FLTR,IANS1) 0103 

C CALL GNFLT1(B,2,FLTR, IANS2) 0104 

C CALL GNFLTKB, 1005, FLTR, IANS3) 0105 

C OUTPUTS - IANS = -1 (ILLEGAL AMSPEC, ALL ZERO) 0106 

C IANS2 = IANS3 = -2 (ILLEGAL LSPEC) 0107 

C 0108 

DIMENSION AMSPEC(IOO), FLTR(2001) 0109 

C CHECK LSPECAMSPEC 0110 

I ANS=-2 0111 

IFUSPEC-3) 9999,10,10 0112 

10 IF(LSPEC-lOOl) 20,20,9999 0113 

20 I ANS=-1 0114 

00 30 1=1, LSPEC 0115 

IF ( AMSPEC ( I ) ) 50,30,50 0116 

30 CONTINUE 0117 

C ILLEGAL AMSPEC IF FALLS THRU 30 0118 

GO TO 9999 0119 

C INPUTS OK, INITIALIZE LOOP WHICH FORMS FILTER (0,1, ...M) 0120 

C IN FLTR(M+1,..., LSPEC) 0121 

50 IANS^O 0122 

M=LSPEC-1 0123 

FM=FLOATF ( M ) 0124 

PI0VM=3. 14159265/FM 0125 

IXS=0 0126 
C ENTER LOOP ON S^O , 1 , • . • M****»»********»»»»»»»»»»««»**»»*«*«********»»* 0127 

100 FIXS=FLOATF( IXS) 0128 

C=1.0 0129 

IF (IXS-M) 115,110,110 0130 

110 C=0.5 0131 

115 ARGl=FIXS»PIOVM 0132 

C0S1=C0SF(ARG1) 0133 

SUM*0.0 0134 

IXP=0 0135 
C ENTER LOOP ON I XP=0* 1 , . .. M» »*»«**** ***•»»« *♦*****»*******»**»»•*••»*»» 0136 

130 FIXP=FLOATF( IXP) 0137 

FNRM=1 .O/FM 0138 

IF(IXP) 140,150,140 0139 

140 IF(IXP-M) 160,150,160 0140 

150 FNRM=0.5/FM 0141 

160 ARG2=ARG1»FIXP 0142 

ORT-C*( ( .54+.46*C0Sl ) *COSF( ARG2) ) 0143 

C FIND AMSPEC AND BUMP SUM 0144 

I=IXP+1 0145 

AMP=AMSPEC( I ) 0146 

SUM = SUM ♦ AMP*FNRM*ORT 0147 

C INDEX ON IXP AND CHECK FOR MORE 0148 

IXP=IXP+1 0149 
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IF(IXP-M) 130,130,200 


0150 


C STORE FILTER(S) AND F ILTER{ -5 ) 


0151 


200 I»IXS+M+1 


0152 


J=-IXS+M+1 


0153 


FLTR ( I ) -SUM 


0154 


FLTRU) = SUM 


0155 


C INDEX ON IXS AND CHECK FOR MORE 


0156 


IXS=IXS+1 


0157 


IF( IXS-M) 100,100,300 


0158 


C ALL DONE 


0159 


300 GO TO 9999 


0160 


C EXIT 


0161 


9999 RETURN 


0162 


END 


0163 
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* GNHOL2 (SUBROUTINE) 9/29/64 LAST CARO IN DECK IS NO* 0157 

* FAP 0001 
•GNH0L2 0002 

COUNT 100 0003 

LBL GNH0L2 0004 

ENTRY GNH0L2 (DATA, NDATA, FMT, HOL, NCRS, IXCOM, INDEX) 0005 

* 0006 
» ABSTRACT 0007 

* 0008 

* TITLE - GNH0L2 0009 

* GENERATE HOLLERITH CHARACTERS 0010 
» 0011 

* GNH0L2 GENERATES HOLLERITH CHARACTERS FROM DATA AND 0012 

* FORMAT INFORMATION IN THE CALLING SEQUENCE* 0013 
» 0014 

* LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0015 
« EQUIPMENT - 709 OR 7090 0016 

* STORAGE - 74 REGISTERS 0017 

* SPEED - 0018 

* AUTHOR - R.A. WIGGINS 3/63 0019 

* * 0020 

» USAGE 0021 

» 0022 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0023 

* AND FORTRAN SYSTEM ROUTINES - (IOH),(FIL) 0024 
» 0025 
« FORTRAN USAGE 0026 

* CALL GNHQL2(DATA,NDATA»FMT,H0LtNCRS, IXCOM, INDEX ) 0027 

* 0028 

* INPUTS 0029 

* 0030 

* DATA ( I ) 1=1 f • . . ,NDATA CONTAINS FLOATING POINT NUMBERS, FIXED 0031 

* POINT OR MACHINE LANGUAGE INTEGERS, OR ALPHANUMERIC 0032 
» CHARACTERS WHICH ARE TO BE INSERTED IN THE HOLLERITH 0033 

* OUTPUT ACCORDING TO THE FORMAT FMT. 0034 

* 0035 
» NDATA MUST BE GRTHN-0 0036 

* 0037 

* FMT ( I ) I=M,..*,1 (M ARBITRARY) CONTAINS A FORMAT STATEMENT 0038 

* WHICH IS TO BE INTERPRETED TO GENERATE THE HOLLERITH. 0039 

* FMT IS STORED IN REVERSE ORDER* IE FMT(M) CONTAINS THE 0040 

* FIRST WORD (AND IS THE ARGUMENT GIVEN GNH0L2), FMT(M-l) 0041 

* CONTAINS THE SECOND WORD, ETC. 0042 

* IS MOST EASILY GENERATED BY A HOLLERITH FIELD INSIDE 0043 

* THE CALL STATEMENT (SEE EXAMPLES). 0044 

* 0045 

* INDEX IS ANY FIXED POINT INTEGER. 0046 
» 0047 

* OUTPUTS 0048 

* 0049 

* HOL(I) 1=1,... ,NCRS/6 CONTAINS THE HOLLERITH CHARACTERS (6 PER 0050 

* WORD, IN FORTRAN ORDER) THAT IS GENERATED FROM THE 0051 

* FORMAT AND DATA VECTORS. 0052 
» 0053 

* NCRS IS 6 TIMES THE NUMBER OF WORDS IN HOL. 0054 

* 0055 

* IXCOM IS THE INDEX, WITH RESPECT TO COMMON OF THE FIRST WORD 0056 

* OF HOL. 0057 

* 0058 

* INDEX IS INCREASES BY ONE FROM THE INPUT VALUE. 0059 
« 0060 

* EXAMPLES 0061 
« 0062 

* 1. GENERATION OF HOLLERITH CHARACTERS WITH NO DATA. 0063 
» INPUTS - NDATA-O INDEX=4 0064 

* USAGE - COMMON HOL 0065 

* CALL GNH0L2 (DATA, NDATA, 21H( 16HSAMPLE HOLLERITH), 0066 

* 1 HOL » NCRS » IXCOM, INDEX ) 0067 

* OUTPUTS - H0L(1...3) = 6HSAMPLE HOLLERITH NCRS=18 IXC0M=1 INDEX=5 0068 

* 0069 

* 2. GENERATE HOLLERITH WITH DATA 0070 

* INPUTS - DATA(l)*5. NDATA^l INDEX=5 0071 

* USAGE - COMMON HOL 0072 

* CALL GNH0L2 ( DAT A ,NDAT A, 23H( 14H ERROR FLAG * F4*l), 0073 
» 1 HOL, NCRS, IXCOM, INDEX ) 0074 
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• OUTPUTS 


- H0LU...3) 


= 6H ERROR FLAG 5,0 




0075 


• 


NCRS = 18 


IXCOM = 1 INDEX * 6 




0076 


* 








0077 


* 3. GENERATE 


HOLLERITH FROM A FORMAT DEFINED OUTSIDE THE CALL 


STATEMENT 


0078 


* INPUTS 


- NDATA = 0 


INDEX = 6 FMT{ 4) = 6H( 16HSA 




0079 


• 




FMT ( 3) » 6HMPLE H 




0080 


• 




FMT ( 2 ) = 6H0LLERI 




0081 


* 




FMT ( 1 ) * 3HTH) 




0082 


* USAGE 


COMMON HOL 




0083 


* 


CALL 


GNH0L2 ( DATA, NDATA , FMT ( 4 ) , HOL , NCRS, I XCOM , 


0084 


* 


I 


INDEX) 




0085 


» OUTPUTS 


- H0H1...3) 


= 6HSAMPLE HOLLERITH NCRS=18 IXCOM* 


1 INDEX«7 


0086 


* 








0087 


HTR 


0 






0088 


BCI 


1 1 GENHOL 






0089 


GNH0L2 SXD 


*-2,4 


SAVE 




0090 


SXA 


£X f i 


INDEX 




0091 


SXA 


EX+1,2 


REGISTERS. 




0092 


CAL 


1,4 


GET 




0093 


ADO 


= 1B35 


ADDRESS OF 




0094 


STA 


DATA 


DATA. 




0095 


CAL» 


2,4 


GET NUMBER 




0096 


STD 


NDATA 


OF DATA WORDS. 




0097 


CAL 


3,4 


GET POSITION 




0098 


STA 


FMT 


OF FORMAT. 




0099 


CAL 


4,4 


GET POSITION 




0100 


AOD 


= 1B35 


OF 




0101 


STA 


HOL 


HOL. 




0102 


ALS 


18 


SET 




0103 


SUB 


=32563B17 


OUTPUT 




0104 


STD* 


6,4 


OF IXCOM. 




0105 


SXA 


N,0 


RESET N COUNTER. 




0106 


AXC 


FMT-1,4 


SET IR 4 FOR DUMMY PRINT. 




0107 


(SSH) CLA 


=4B17 


DUMMY UNIT DESIGNATION 




0108 


LDQ 


*+2 






0109 


TRA* 


$ ( I OH ) 


♦INITIALIZE ( IOH) 




0110 


TRA 


SSH 


OUTPUT / STORAGE TO STORAGE 


HOLLERITH 


0111 


• 




REENTRY FROM < IOH) 




0112 


SSH SXA 


OUT, 4 


SAVE 




0113 


SXA 


OUT+1,2 


INDEX 




0114 


SXA 


OUT+2,1 


REGISTERS. 




0115 


CAL 


lt4 


GET 




0116 


ARS 


18 


ADDRESS 




0117 


ADD 


1,4 


OF BEGINNING 




0118 


STA 


HOL1 


OF RECORD. 




0119 


PDX 


»2 


SAVE 




0120 


SXD 


A, 2 


LENGTH 




0121 


SXD 


N+1,2 


OF RECORD. 




0122 


N AXT 


**,1 


INCREMENT 




0123 


TXI 


*+l , 1, «* 


THE LENGTH 




0124 


SXA 


N,l 


OF HOL. 




0125 


AXT 


1,2 


MOVE 




0126 


HOL1 CLA 


♦♦,2 


HOLLERITH 




0127 


HOL STO 


**♦ 1 


FROM < IOH) 




0128 


TIX 


**1,1,1 


BUFFER TO 




0129 


TXI 


*+l,2,l 


HOL. 




0130 


A TXL 


H0L1,2,** 






0131 


OUT AXT 


**,4 


RESTORE 




0132 


AXT 


**,2 


INDICES 




0133 


AXT 


**, 1 


AND 




0134 


TRA 


2,4 


» RETURN TO < IOH). 




0135 


• 




DUMMY PRINT 




0136 


FMT PZE 


**, ,1 


FORMAT DESIGNATION. 




0137 


AXT 


1,1 


INDEXING. 




0138 


NDATA TXL 


*+2,l,»* 






0139 


TRA 


C 






0140 


DATA LDQ 


»*,1 


OUTPUT 




0141 


STR 




LIST. 




0142 


TXI 


NDATA, 1,1 


INDEXING 




0143 


C TSX 


$(FIL) ,4 


* RETURN TO (IOH). 




0144 


LXD 


GNHOL2-2,4 


FINAL ENTRY FROM (IOH). 




0145 


LXA 


N,2 


GET 




0146 


PXA 


,2 


NCRS 




0147 


XCA 








0148 


MPY 


=6817 






0149 
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STQ* 


5,4 


CLA* 


7,4 


AOO 


= 1B17 


STO* 


T,4 


AXT 


♦♦,1 


AXT 


• ♦,2 


TRA 


8,4 


END 
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FOR OUTPUT. 


0150 


INCREMENT 


0151 


INDEX 


0152 


8Y one; 


0153 


EXIT 


0154 




0155 




0156 




0157 
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• GRAPH (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 1102 

♦ LABEL 0001 
CGRAPH 0002 

SUBROUTINE GRAPH ( ISOLf IDOT?N, TITLE? YUN ITS? XUN ITS? YTOP?YBOT, 0003 
1 XMAX?XMIN?NOPPP? IPAGE?SPACE) 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - GRAPH 0008 

C MULTIPLE FRAME SCOPE PLOTS OF VECTOR SETS 0009 

C 0010 

C GRAPH MAKES A SIMULTANEOUS PLOT OF AN ARBITRARY NUMBER 0011 

C OF SERIES ACROSS AS MANY SCOPE FRAMES AS NEEDED. RESULTING 0012 

C PHOTOS CAN BE ABUTTED TO GIVE CONTINUOUS GRAPH, 0013 

C 0014 

C USER SUPPLIES HOLLERITH LABELS? SCALING AND PLOTTING 0015 

C PARAMETERS, FROM WHICH GRAPH DETERMINES SUITABLE CHECK 0016 

C MARKS AND LABELS FOR AXES. 0017 

C 0018 

C SUCCESSIVE FRAMES ARE SERIALIZED FROM AN INPUT VALUE 0019 

C 0020 

C OPTIONS INCLUDE SOLID OR DOTTED MODE OF PLOTTING AND 0021 

C HISTOGRAM-STYLE OR CUBIC-CURVE INTERPOLATION BETWEEN 0022 

C SUCCESSIVE POINTS 0023 

C 0024 

C LANGUAGE - FORTRAN II SUBROUTINE 0025 

C EQUIPMENT - 709 OR 7090 PLUS 740 CRT RECORDER. (AND 780 CRT DISPLAY) 0026 

C STORAGE - 1499 REGISTERS 0027 

C SPEED - ON THE ORDER OF 2 SECONDS OR MORE PER FRAME (7090). 0028 

C AUTHOR - S.M.SIMPSON JR f NOV 1961 0029 

C 0030 

C USAGE 0031 

C 0032 

C TRANSFER VECTOR CONTAINS ROUTINES - DISPLA? LINE? XFIXM? FLOATM, 0033 

C DSPFMT? FRAME, MVBLOK, SCPSCL 0034 

C HSTPLT 0035 

C AND FORTRAN SYSTEM ROUTINES - (SPH)? (FID, LOG? EXP(2, XLOC 0036 

C 0037 

C NOTE-HSTPLT PLOTS THE DATA. THERE ARE SEVERAL 0038 

C VERSIONS OF THIS ROUTINE WHICH DIFFER IN THE 0039 

C PLOTTING STYLE USED (HISTOGRAM, CUBIC INTER- 0040 

C POLATION, VERTICAL LINES). USER SHOULD SELECT 0041 

C ONE (ALL HAVE CALLING SEQUENCES COMPATIBLE 0042 

C TO GRAPH) 0043 

C FORTRAN USAGE 0044 

C CALL GRAPH ( I SOL? ID0T?N,TITLE?YUNITS?XUNITS? YTOP?YBOT? 0045 

C 1 XMAX,XMIN,NOPPP? IPAGE?SPACE) 0046 

C 0047 

C PRELIMINARY DEFINITIONS 0048 

C GRAPH PLOTS AN ARBITRARY NUMBER?NS?OF FLOATING POINT 0049 

C SERIES IN THE SOLID MODE? PLUS AN ARBITRARY NUMBER?ND» 0050 

C OF FLOATING POINT SERIES IN THE DOTTED MODE. NS OR 0051 

C ND MAY BE ZERO. ALL SERIES HAVE THE SAME NO. OF TERMS? N. 0052 

C 0053 

C LET THE SERIES TO BE PLOTTED SOLID BE DEFINED BY 0054 

C YSK1...N), YS2( 1...N)?...? YSNSU...N) 0055 

C A TYPICAL MEMBER WILL BE REFERRED TO BY YSU...N) 0056 

C 0057 

C AND THE SERIES TO BE PLOTTED DOTTED BE 0058 

C YDK1...N), YD2(1...N),...? YDND(1...N) 0059 

C A TYPICAL MEMBER WILL BE REFERRED TO BY YDI1...N) 0060 

C 0061 

C A TYPICAL SERIES DISREGARDING PLOTTING MODE IS YU...N) 0062 

C Y(I) IS CONCEIVED AS CONTAINING THE FUNCTION YY(X)? 0063 

C WITH EQUAL INCREMENTS OF THE INDEPENDENT ARGUMENT X 0064 

C OCCURRING BETWEEN SUCCESSIVE INDICES? IE 0065 

C Y(1?2...N) » YY(XMIN?XMIN+DEL?XMIN+2»DEL?...?XMAX) 0066 

C WHERE DEL = ( XMAX-XM IN ) /N 0067 

C 0068 

C INPUTS 0069 

C 0070 

C ISOL(I) I=1...NS+1 IS A VECTOR WHICH GIVES THE LOCATIONS OF ALL 0071 

C SERIES WHICH ARE TO BE PLOTTED IN THE SOLID MODE 0072 

C ISOL(l) * XLOCF(YSl) 0073 
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C PAGE 2) (PAGE 2) 

C ISOL(2) * XL0CF(YS2) 0074 

C ETC. 0075 

C ISOL(NS) = XLOCF(YSNS) 0076 

C ISOL(NS+i) = 0 0077 

C (THE TERMINAL ZERO STOPS GRAPH FROM LOOKING FOR MORE 0078 

C SERIES) 0079 

C 0080 

C IOOT(I) I=l...ND+l IS A VECTOR WHICH GIVES THE LOCATIONS OF ALL 0081 

C SERIES TO BE PLOTTED IN THE DOTTED MODE 0082 

C IDOTd) = XLOCF(YDl) 0083 

C ID0T(2) = XL0CF(YD2) 0084 

C ETC. 0085 

C IDOT(ND) * XLOCF ( YDND) 0086 

C ID0T(ND+1) * 0 0087 

C 0088 

C N IS THE COMMON LENGTH OF ALL SERIES TO BE PLOTTED 0089 

C MUST EXCEED 1 0090 

C 0091 

C TITLE(I) 1=1. ..8 CONTAINS 48 HOLERITH (8A6 FORMAT) TO BE USEO 0092 

C AS A HEADING TITLE ON ALL FRAMES. 0093 

C OPTIONALLY THESE 48 HOLERITH MAY BE GIVEN TO GRAPH BY 0094 

C THE LITERAL APPEARANCE IN THE CALLING SEQUENCE OF 0095 

C 54H$$$ i$$HOLER I THHOLER I THHOLER I THHOLER I THHOLER I THHOLER I TH 0096 

C THE FIRST MODE IS USFUL FOR HOLERITH WHICH THE USER 0097 

C AQUIRES BY FORTRAN READ STATEMENTS. 0098 

C THE SECOND MODE IS USEFUL WHEN THE TITLE TO BE USED 0099 

C IS A CONSTANT OF THE USERS PROGRAM. 0100 

C THE TWO MODES HAVE A REVERSED SENSE OF STORAGE DIRECTION 0101 

C GRAPH DISTINGUISHES BETWEEN THE MODES BY THE PRESENCE OR 0102 

C ABSENCE OF 6 DOLLAR SIGNS IN TITLE(l). 0103 

C CONSEQUENTLY, FOR MODE 1 THE FIRST 6 OF THE 48 HOLERITH 0104 

C MUST NOT ALL BE DOLLAR SIGNS. 0105 

C 0106 

C YUNITS(I) 1*1. ..6 CONTAINS 36 HOLERITH (6A6 FORMAT) TO BE USED AS 0107 

C A DESCRIPTIVE TITLE, ON THE VERTICAL AXIS, OF THE 0108 

C UNITS OF Y ( I ) . 0109 

C OPTIONALLY THESE 36 HOLERITH MAY BE GIVEN TO GRAPH BY 0110 

C THE LITERAL APPEARANCE IN THE CALLING SEQUENCE OF 0111 

C 42H$$$ $$$ HOLER I THHOLER I THHOLCR ITHHOLER I THHOLE 0112 

C (IF FIRST MODE IS USED YUNITS(l) MUST NOT = $$$$$$) 0113 

C 0114 

C XUNITS(I) 1=1.. .6 CONTAINS 36 HOLERITH (6A6 FORMAT) TO BE USED AS 0115 

C A DESCRIPTIVE TITLE, ON THE HORIZONTAL AXIS, OF THE 0116 

C UNITS OF X 0117 

C OPTIONALLY THESE 36 HOLERITH MAY BE GIVEN TO GRAPH BY 0118 

C THE LITERAL APPEARANCE IN THE CALLING SEQUENCE OF 0119 

C 42H$$$$$$H0LER I THHOLER I THHOLER ITHHOLER I THHOLE 0120 

C (IF FIRST MODE IS USED XUNITS(l) MUST NOT = *$$$$$) 0121 

C 0122 

C YTOP DEFINES THE TOP OF THE PLOTTING AREA, SUCH THAT IF SOME 0123 

C Y(I) = YTOP THEN Y(I) IS PLOTTED ON THE UPPERMOST 0124 

C EDGE OF THE PLOTTING AREA 0125 

C IF ANY Y(I) EXCEEDS YTOP IT WILL BE TREATED AS 0126 

C THOUGH IT WERE = YTOP 0127 

C YTOP MUST EXCEED YBOT 0128 

C 0129 

C YBOT DEFINES THE BOTTOM OF THE PLOTTING AREA, SUCH THAT IF 0130 

C SOME Yd) = YBOT THEN Y( I) IS PLOTTED ON THE 0131 

C LOWERMOST EDGE OF THE PLOTTING AREA. 0132 

C IF ANY Y(I) IS LSTHN YBOT IT WILL BE TREATED AS 0133 

C THOUGH IT WERE = YBOT 0134 

C 0135 

C VALUES OF Yd) BETWEEN YTOP AND YBOT ARE PLOTTED 0136 

C PROPORTIONALLY BETWEEN THE UPPER AND LOWER EDGES. 0137 

C 0138 

C XMAX IS THE ARGUMENT VALUE CORRESPONDING TO Y(N) = YY(XMAX) 0139 

C XMAX MUST EXCEED XMIN 0140 

C 0141 

C XMIN IS THE ARGUMENT VALUE CORRESPONDING TO Yd) = YY(XMIN) 0142 

C 0143 

C NOPPP IS THE DESIRED NO OF POINTS PER PAGE TO BE PLOTTED 0144 

C Yd. ..NOPPP) APPEARS ON FIRST FRAME 0145 

C Y(N0PPP...2*N0PPP-l) ON SECOND FRAME, ETC. 0146 

C MUST EXCEED 2 0147 
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GRAPH 



IPAGE 



SPACE(I) I=l...NOPPP MUST BE AVAILABLE TO GRAPH FOR SCRATCH WORK 



IPAGE 



SPACE(l) 



C 
C 
C 
C 
C 
C 
C 
C 

C OUTPUTS 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 

C SCOPE OUTPUTS 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

C APLOT 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 



MUST BE LSTHN=401 

IS AN INITIAL PAGE NO. TO BE PRINTEO ON FIRST FRAME 
IPAGE+l,IPAGE+2,... APPEARS ON SUCCESSIVE FRAMES 
IS TREATED MODULO 1000 



IS LEFT « ILAST+1 WHERE ILAST IS THE PAGE NO. APPEARING 
ON THE LAST FRAME USED BY GRAPH, THUS UPDATING IPAGE 
FOR A SUBSEQUENT CALL OF GRAPH. 

IS USED AS AN ERROR INDICATOR 
=0.0 IF NO TROUBLE 

=1.0 IF Nt YTOPfXMAX OR NOPPP IS ILLEGAL 

OR IF BOTH ISOL(l) AND IDOT(l) = 0 



THE SCOPE OUTPUTS WILL BE DEFINED IN TERMS OF THE SCOPE 
AREAS AFFECTED. IT SHOULD BE NOTED FIRST THAT GRAPH 
DOES NOT CHANGE FRAMES BEFORE PLOTTING THE FIRST FRAME 
NOR AFTER PLOTTING THE LAST ONE, THUS PERMITTING THE 
USER TO PLOT ADDITIONAL INFORMATION ON THESE TWO FRAMES. 
BY THE SAME TOKEN HOWEVER USER MUST CHANGE FRAMES 
BETWEEN SUCCESSIVE CALLS TO AVOID SUPERPOSITION. 

THE SCOPE FACE IS A SQUARE GRID OF POINTS <X,Y> WHERE 
X AND Y CAN RANGE FROM 0 TO 1023. LET (0,01 BE THE 
LOWER LEFT CORNER AND (1023,1023) THE UPPER RIGHT 
CORNER WITH Y THE VERTICAL DIMENSION. THEN LET 

(X1,Y1)-(X2,Y2) 
STAND FOR THE RECTANGULAR AREA WHOSE DIAGONAL RUNS 
FROM (X1,Y1) TO (X2,Y2) 
DEFINE THE FOLLOWING AREAS 

APLOT = (175, 150)-( 1015,990) 

ATI TLE = (5, 1000)-( 1013,1021) 

AYUNIT = (31, 108 )-( 10,864) 

AYAROW = (31, 864)-( 10,910) 

AYCKNO = (76,140)-( 160, 1000) 

AYSCAL = (7i, 120)~( 50,981) 

AXUNIT = (87,30)-( 843, 51) 

AXAROW = (843,30)-(880,51) 

AXCKNO = (167, 55)-( 1023,140) 

AXSCAL = ( 144, 5)~( 1005,26) 

APAGE = ( 10, 70)-( 157,91) 

ACHEX = (0,0)-(63,21) 

AERROR = (100,500)-(688,521) 
THEN 

IS THE PLOTTING AREA (SQUARE). IT IS BOXED IN ON ALL 4 
SIDES BY STRAIGHT LINES WITH CHECK MARKS ALL AROUND. 
THE VERTICAL CHECK MARK SEQUENCE (BETWEEN 20 AND 50) 
IS DETERMINED BY GRAPH SO AS TO DEFINE INTEGRAL POWERS 
OF 10 IN THE UNITS OF Y, AND A SIMILAR SEQUENCE IS 
DEVELOPED IN THE X DIRECTION. 

IF THE VALUE Y=0. FALLS BETWEEN YTOP AND YBOT, A 
CORRESPONDING HORIZONTAL AXIS IS DRAWN IN ON ALL FRAMES 

IF THE VALUE X=0. OCCURS ON SOME FRAME A VERTICAL 
AXIS IS DRAWN IN AND SUPPLIED WITH Y UNIT CHECK MARKS 

THE DATA Y(I) ARE PLOTTED EQUALLY SPACED IN THE X 
DIRECTION ACROSS THE PLOTTING AREA SUCH THAT YU) 
IS AT THE LEFT EDGE OF FRAME 1, Y(NOPPP) AT THE 
RIGHT EDGE OF FRAME 1,Y(N0PPP) AGAIN APPEARS AT 
THE LEFT EDGE OF FRAME 2, ETC. TILL THE DATA ARE GONE 

USE OF THE HISTOGRAM VERSION OF SUBROUTINE HSTPLT 
GIVES THE DATA PLOTTED AS HORIZONTAL BARS (WIDTH = 
PLOTTING WIDTH/(N0PPP~1) ) CONNECTED BY VERTICAL LINES, 
THE LINES AND BARS BEING SOLID OR DOTTED ACCORDING 
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0148 
0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
0197 
0198 
0199 
0200 
0201 
0202 
0203 
0204 
0205 
0206 
0207 
0208 
0209 
0210 
0211 
0212 
0213 
0214 
0215 
0216 
0217 
0218 
0219 
0220 
0221 
0222 
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< PAGE 



ATITLE 
AYUNIT 
AYAROW 
AYCKNO 

AYSCAL 

AXUNIT 

AXCKNO 

AXSCAL 

APAGE 

ACHEX 

AERROR 



TO ISOL, IDOT. THIS VERSION ALSO SUPPLIES AN 
ADDITIONAL SET OF CHECK MARKS TO THE BOTTOM OF THE 
PLOTTING AREA (OR TO THE Y=0. AXIS IF PRESENT) 
WHICH LOCATE THE CENTERS OF THE HISTOGRAM BARS. FOR 
NOPPP LESS THAN 81 THERE IS ONE SUCH CHECK FOR EACH 
BAR, FOR 81 LSTHN^ NOPPP L I STHN- 160 ONE CHECK FOR 
EVERY OTHER BAR, FOR NOPPP GRTHN* 161 ONE CHECK FOR 
EVERY FIFTH BAR. 

THE CUBIC INTERPOLATOR VERSION OF HSTPLT FITS AND 
PLOTS A CUBIC CURVE 8ETWEEN SUCCESSIVE POINTS. THE 
POINTS THEMSELVES ARE DARKENED. THE HORIZONTAL AXIS 
WITH CHECKS IS PLOTTED AS IN THE ABOVE CASE. THE 
VERTICAL BAR VERSION OF HSTPLT DRAWS A LINE FROM EACH 
POINT TO A HORIZONTAL AXIS. THE VERTICAL POSITION OF 
THIS AXIS IS DEFINED BY THE FIRST VALUE IN THE SERIES. 
NO HORIZONTAL AXIS IS DRAWN FOR THE VALUE Y=0. 

OF THE REMAINING AREAS ONLY ATITLE, AXCKNO AND APAGE 
ARE CONTINUED BEYOND THE FIRST FRAME. 

WILL SHOW THE 48 HOLERITH IN TITLE(1...8) 

WILL SHOW THE 36 HOLERITH IN YUNITU...6) 

IS A VERTICAL ARROW 

SHOWS A SEQUENCE OF INTEGERS DEFINING THE VALUES OF 

Y CORRESPONDING TO THE CHECK MARKS ON THE VERTICAL AXIS 

MAY BE BLANK, OTHERWISE IT CONTAINS A DESCRIPTION OF 
HOW TO MODIFY THE INDICATED UNITS IN AYCKNO SO AS 
TO YIELD TRUE SCALE. 

WILL SHOW THE 36 HOLERITH IN XUNITU...6) 

IS LIKE AYCKNO BUT FOR THE HORIZONTAL AXIS 

IS LIKE AYSCAL BUT APPLIES TO AXCKNO 

IS THE PAGE NO SERIALIZING AREA STARTING WITH VALUE IPAGE 

GIVES THE (NO. HISTOGRAM CHKMARKS ) / ( DATA POINT) RATIO 

* BLANK IF RATIO * 1 

* 1/2 IF 1 CHK /(2 DATA PTS) 
» 1/5 IF 1 CHK /(5 DATA PTS) 



NOT USED NORMALLY 

SAYS ILLEGAL ARGUMENT FOR GRAPH 



IF ANY ARGUMENT ILLEGAL 



EXAMPLES 

EXAMPLES 1. THRU 4. ARE INTENDED TO BE RUN USING THE HISTOGRAM 
STYLE VERSION OF SUBROUTINE HSTPLT. EXAMPLES 6. AND 7. SHOW EFFECTS 
OF OTHER VERSIONS. 

1. SINGLE FRAME EXAMPLE 

INPUTS - YS1U...201)* C0SF(0.),l.05),(.10),... 
YS2(1...201)=: .600, .615, .630,... 
YD1 (l.* .201 )= 2.»SINF(0.), (.15), ( .30),... 
IS0L(1*..2)= XL0CF(YS1).CYS2) IS0L(3)=0 
ID0T(1)= XLOCF(YDl) ID0T(2)=0 
YTOP= 3.5 YBOT- -2.2 
N=201 

XMAX= 405. XMIN= -630. 
TITLEU...8)* 

48HTHESE CHARACTERS COMPLETELY COVER THE TITLE AREA 
IPAGE=1 
N0PPP=201 
USAGE - CALL FRAME 

CALL GRAPH( ISOL, IDOT,N, TITLE, 

1 42H$$$$$$THESE CHARACTERS FILL UP YUNITS AREA, 

2 42H$$$$$$THESE CHARACTERS FILL UP XUNITS AREA, 

3 YTOP, YBOT, XMAX,XMIN, NOPPP, IPAGE, SPACE) 
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0223 
0224 
0225 
0226 
0227 
0228 
0229 
0230 
0231 
0232 
0233 
0234 
0235 
0236 
0237 
0238 
0239 
0240 
0241 
0242 
0243 
0244 
0245 
0246 
0247 
0248 
0249 
0250 
0251 
0252 
0253 
0254 
0255 
0256 
0257 
0258 
0259 
0260 
0261 
0262 
0263 
0264 
0265 
0266 
0267 
0268 
0269 
0270 
0271 
0272 
0273 
0274 
0275 
0276 
0277 
0278 
0279 
0280 
0281 
0282 
0283 
0284 
0285 
0286 
0287 
0288 
0289 
0290 
0291 
0292 
0293 
0294 
0295 
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OUTPUTS - IPAGE=2 SPACE* 1>=0. 




DOUBLE FRAME EXAMPLE 

INPUTS - SAME AS EXAMPLE 1 EXCEPT NOPPP* 120 
USAGE - SAME AS EXAMPLE 1 
OUTPUTS - IPAGE= 3 SPACE(1)=0. 




EXPLODED VIEW OF EXAMPLE 2 

INPUTS - SAME AS EXAMPLE 2. EXCEPT YTOP= .35 
USAGE - SAME AS EXAMPLE 1 



YB0T*~.22 



0296 
0297 
0298 
0299 
0300 
0301 
0302 
0303 
0304 
0305 
0306 
0307 
0308 
0309 
0310 
0311 
0312 
0313 
0314 
0315 
0316 
0317 
0318 
0319 
0320 
0321 
0322 
0323 
0324 
0325 
0326 
0327 
0328 
0329 
0330 
0331 
0332 
0333 
0334 
0335 
0336 
0337 
0338 
0339 
0340 
0341 
0342 
0343 
0344 
0345 
0346 
0347 
0348 
0349 
0350 
0351 
0352 
0353 
0354 
0355 
0356 
0357 
0358 
0359 
0360 
0361 
0362 
0363 
0364 
0365 
0366 
0367 
0368 
0369 
0370 
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OUTPUTS 



IPAGE* 



SPACE<1)= .0 




4. SOME EXTREME SCALING 



INPUTS 



USAGE 
OUTPUTS 



SAME AS EXAMPLE I EXCEPT 

YS1<1...800)= -32456.+C0SF(0.), ( .05 ) , ( . 10 ) , . « 

IS0L(1)= XLOCF(YSl) IS0L<2)=0 IDOT(l)=0 
YTOP= -32454. YBOT= -32458. 

XMAX* .45678*10**{-7) XMIN=.45677*10»*<-7) 
NOPPP=401 IPAGE=7 
SAME AS EXAMPLE 1 
IPAGE* 9 SPACEtl)= 0. 



H £ SE XHARftCTERS COMPLETELY COVER THE TITLE ARES 



N = 800 




5. ERROR CONDITIONS 

USAGE - CALL GRAPH( ISOL, IDOT,0, TITLE, YUNITS,XUNITS, 10. ,5. , 

7.,2.,100,2,SPACEU)) 
CALL GRAPH( ISOL, IDOT , 5, T I TLE , YUN I TS , XUNI TS, 5 . , 5. , 

7.,2.,100,2,SPACE<2)) 
CALL GRAPH( ISOL, IOOT, 5, TITLE, YUN ITS, XUNI TSt 10. ,5. , 

l.,2.,100,2,SPACE<3>) 
CALL GRAPH! ISOL, IOOT, 5, TITLE, YUNITS,XUNITS, 10. ,5. , 

7. f 2.,2,2,SPACE<4)) 
CALL GRAPH! ISOL, I DOT , 5, T ITLE, YUN I TS, XUN I TStlO. #5. , 
7.,2.,500,2,SPACE<5>) 
OUTPUTS - SPACE(1)^1. (ILLEGAL N) SPACE<2)=1. i ILLEGAL YTOP) 



0371 
0372 
0373 
0374 
0375 
0376 
0377 
0378 
0379 
0380 
0381 
0382 
0383 
0384 
0385 
0386 
0387 
0388 
0389 
0390 
0391 
0392 
0393 
0394 
0395 
0396 
0397 
0398 
0399 
0400 
0401 
0402 
0403 
0404 
0405 
0406 
0407 
0408 
0409 
0410 
0411 
0412 
0413 
0414 
0415 
0416 
0417 
0418 
0419 
0420 
0421 
0422 
0423 
0424 
0425 
0426 
0427 
0428 
0429 
0430 
0431 
0432 
0433 
0434 
0435 
0436 
0437 
0438 
0439 
0440 
0441 
0442 
0443 
0444 
0445 
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c 




c 




c 




C 6. 


c 




r 
v» 




Q 




c 








r 
i» 




Q 








C 




/* 
v» 




Q 




Q 


t 




T 


c 


I 


Q 


Ui 






Q 


I 


v» 




r 
v* 


11 


c 




c 






IT' 


r 
U 


> 


r 




C 




r 




c 


-J 




-J 


v» 


— 


r 

V 


u 


r 
L> 


t-"» 


r 
v» 


Ol 


r 


uj 




h— 


r 


O 

a; 


r 


a. 


C 


i 


C 


X 


c 




c 




c 


UJ 


c 


Id 


c 


X 


c 




c 




c 




c 




c 




c 




c 




c 




C 7. 


c 




c 




c 




c 




c 




c 





SPACE(3)=1. 
SPACE(5)*1. 



(ILLEGAL XMAX) SPACE(4)=1, 
(ILLEGAL NOPPP) 



( ILLEGAL NOPPP) 



USE OF CUBIC INTERPOLATION VERSION OF HSTPLT 

(NOTE- THERE IS A 709 AND A 7090 VERSION OF THIS HSTPLT) 
INPUTS - SAME AS EXAMPLE 1 EXCEPT N0PPP=51 
USAGE - DITTO 
OUTPUTS - DITTO 

(ONLY FIRST FRAME SHOWN BELOW) 



UVER J HI 




0 Luauaxia-u«ijuaxiujua^ 



THESE CHARACTERS FILL UP XUh ! TZ mFEw* 
v MULTIPLY INBlCATETi mhit: P v 



USE OF VERTICAL BAR VERSION OF HSTPLT 

NOTE THAT THE VERTICAL POSITION OF THE HORIZONTAL BAR, FROM 

WHICH THE VERTICAL BARS ARE PLOTTED IS DEFINED BY THE INITIAL 
VALUE OF EACH SERIES. 
INPUTS - SAME AS EXAMPLE 1 EXCEPT IS0L(2)=0 YDH1...20U* 2., 

.615, ,630, •645,... 
USAGE - SAME AS EXAMPLE 1 



0446 
0447 
0448 
0449 
0450 
0451 
0452 
0453 
0454 
0455 
0456 
0457 
0458 
0459 
0460 
0461 
0462 
0463 
0464 
0465 
0466 
0467 
I 0468 
0469 
0470 
0471 
0472 
0473 
0474 
0475 
0476 
0477 
0478 
0479 
0480 
0481 
0482 
0483 
0484 
0485 
0486 
0487 
0488 
0489 
0490 
0491 
0492 
0493 
0494 
0495 
0496 
0497 
0498 
0499 
0500 
0501 
0502 
0503 
0504 
0505 
0506 
0507 
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OUTPUTS 



DITTO 



PLETELV COVER THE T I HE 




PROGRAM FOLLOWS BELOW 



DIMENSION STATEMENT FOR ARGUMENTS 

DIMENSION ISOL(lOO),IDOTl 100 ) , T I TLE < 8 ) , YUN I TS1 6 ) , XUNI TS t 61 , 
I SPACEUOl) 
C TRUE DIMENSION STATEMENTS 

DIMENSION HST0RG(4),FMT(10) 
DIMENSION HOLER ( 8 ) 

EQUIVALENCE (ONE, I ONE ) » ( ONEK, IONEK) 
C CHECK LEGALITIES 
IF(N-l) 5,5,1 

1 IF ( YTOP— YBOT ) 5,5,2 

2 IF(XMAX-XMIN) 5,5,3 

3 IF(N0PPP-2> 5,5,4 

4 IF(N0PPP-401) 7,7,5 

7 IF (ISOL) 10,8,10 

8 IF UDOT) 10,5,10 

5 CALL DISPLA 
PRINT 6 

6 F0RMAT(39H2SH100, 500, ILLEGAL ARGUMENT FOR GRAPH ) 
SPACE< 1)*1.0 

GO TO 310 
C INITIAL SETTINGS, ETC 
10 XRNGE=XMAX~XMIN 
YRNGE 35 YTOP- YBOT 
NN=N 

OELX-XRNGE/ I FLOATF C NN-l ) ) 



0508 
0509 
0510 
0511 
0512 
0513 
0514 
0515 
0516 
0517 
0518 
0519 
0520 
0521 
0522 
0523 
0524 
0525 
0526 
0527 
0528 
0529 
0530 
0531 
0532 
0533 
0534 
0535 
0536 
0537 
0538 
0539 
0540 
0541 
0542 
0543 
0544 
0545 
0546 
0547 
0548 
0549 
0550 
0551 
0552 
0553 
0554 
0555 
0556 
0557 
0558 
0559 
0560 
0561 
0562 
0563 
0564 
0565 
0566 
0567 
0568 
0569 
0570 
0571 
0572 
0573 
0574 
0575 
0576 
0577 
0578 
0579 
0580 
0581 
0582 
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PGDELX=D6LX*FLOATF(NOPPP-l) 0583 

NDELX=( 840. 0*128* 0 ) /FLOATF ( NQPPP-1 ) 0584 

IPAGE=XM0DF(IPAGE,1000) 0585 

B D0LARS=535353535353 0586 

VLP0S=175.0 0587 

VRP0S=1015.0 0588 

HBPOS=150.0 0589 

HTP0S*990.0 0590 

NPL0TD=0 0591 

IYSCLX=76 0592 

IXSCLY=51 0593 

C SET UP FOR BAR PLOTTING BY HSTPLT 0594 

IFRSTB=1 0595 

ISKIPB=i 0596 

IF (N0PPP-80) 415,415,1001 0597 

1001 IF (NOPPP-160) 1002,1002,1003 0598 

1002 ISKIPB=2 0599 
GO TO 1004 0600 

1003 1SKIPB=5 0601 

1004 CALL DISPLA 0602 
PRINT 1005,ISKIPB 0603 

1005 FORMAT (9H2SHI, 1,1/, 111) 0604 
C SET CONVERSION CONSTANTS 0605 

415 CONVL* (HTPOS-HBPOS ) / ( YT0P-Y80T ) 0606 

CONVK=HTPOS-YTOP*CONVL 0607 

CNVL=(VRPOS-VLPGS)/tPGDELX) 0608 

HST0RG(1)=175.0 0609 

HST0RG(3)=1015.0 0610 

C CHECK IF Y=0 LINE APPEARS ON GRAPH (420 IS NO) 0611 

IF (YTOP) 420,420,416 0612 

416 IF(YBOT) 418,420,420 0613 

C IF SO SET 0614 

418 HST0RG(2)*C0NVK 0615 

HST0RG(4)=C0NVK 0616 

GO TO 422 0617 

C IF NOT SET 0618 

420 HST0RG(2)=HBP0S 0619 

HST0RG(4)=HBP0S 0620 

C INITIALIZE NO. PTS TO PLOT ON FIRST PAGE 0621 

422 IF (NOPPP-NN) 424,424,426 0622 

424 NOPTP=NOPPP 0623 

GO TO 428 0624 

426 NOPTP=NN 0625 

C DOES AN X=0 LINE OCCUR ON ANY FRAME (440 IS NO) 0626 

428 IF (XMAX) 440,432,430 0627 

430 IF (XMIN) 432,440,440 0628 

C IF YES SET THE PAGE NO AND THE X COORD ON THAT PAGE 0629 

432 ITEMP1=(-XMIN)/PGDELX 0630 

I PGXZ* I TEMPI* I PAGE 0631 

IPGXZ=XMODF( IPGXZ,1000) 0632 

XZER=VLPOS ♦ 840.0»(-XMIN-PGDELX*FL0ATF( ITEMP1) )/(PGDELX) 0633 

GO TO 450 0634 

440 IPGXZ=0 0635 

XZER=0.0 0636 

C PLOT X AND Y AXIS LABELS WITH ARROWS 0637 

450 IF ( YUNI TS-DOLARS ) 4406,4402,4406 0638 

4402 DO 4404 1=1,6 0639 

J=7-I 0640 

4404 HOLERU)=YUNITS( 1+32762) 0641 

GO TO 4408 0642 

4406 DO 4407 1*1,6 0643 

4407 HOLER ( I ) =YUNITS ( I ) 0644 

4408 CALL DISPLA 0645 
PRINT 452, (H0LER( I ) , 1=1,6) 0646 

452 FORMAT(10H2SV3i,108, 6A6) 0647 

CALL LINE(20. ,868. ,20. ,910. ) 0648 

CALL LINE(28.,895.,20.,910. ) 0649 

CALL LINE(12.,895.,20.,910.) 0650 

IF (XUNITS-DOLARS) 4414,4410,4414 0651 

4410 DO 4412 1*1,6 0652 

J=7-I 0653 

4412 HOLER ( J)=XUNITS( 1+32762 ) 0654 

GC1 TO 4418 0655 

4414 DO 4416 1=1,6 0656 

4416 HOLER ( I )=XUNITS ( I ) 0657 
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4418 CALL DISPLA 0658 

PRINT 454,(H0LER(I),I=1,6) 0659 

454 F0RMAT(9H2SH87,30,6A6) 0660 

CALL LINE(845.,40.,880,,40.) 0661 

CALL LINE(865.,32.,880.,40.) 0662 

CALL LINE(865. ,48. ,880. ,40. ) 0663 

C GO FIND CHECK MARK SETTINGS FOR VERTICAL SCALE 0664 

456 ASSIGN 460 TO ISTOUT 0665 

TOP » YTOP 0666 

B0TT0M=Y80T 0667 

C GO TO INTERNAL SUBROUTINE TO SET UP CHECK MARKS, SCALES 0668 

GO TO 21 0669 

C AFTER COMING BACK GO OUTPUT VERTICAL 0670 

460 ASSIGN 462 TO I SCOUT 0671 

VORH^l.O 0672 

GO TO 520 0673 

C AFTER COMING BACK SCALE STUFFTO SCOPE UNITS FOR FRAME LOOP 0674 

462 VUORG=HBPOS+CONVL*(BRLOU-YBOT) 0675 

VUDEL=CONVL*DBRLOU 0676 

VLORG*HBPOS+CONVL*(BRLOL-YBOT) 0677 

VLDEL 3S C0NVL*DBRL0L 0678 

I NTVL=NBRLOL 0679 

C GO SET HORIZONTAL SCALES 0680 

464 ASSIGN 470 TO ISTOUT 0681 

TOP =XMIN+PGDELX 0682 

BOTTOM=XMIN 0683 

GO TO 21 0684 

C GO OUTPUT HORIZONTAL SCALES 0685 

470 ASSIGN 472 TO I SCOUT 0686 

VORH=0.0 0687 

GO TO 520 0688 

C SCALE STUFF TO SCOPE UNITS FOR FRAME LOOP AND GO THERE 0689 

472 HUORG=VLPOS+CNVL*(BRLOU-XMIN) 0690 

HUDEL-CNVL*DBRLOU 0691 

HLORG=VLPOS+CNVL*(BRLOL-XMIN) 0692 

HLDEL-CNVL* DBRLOL 0693 

INTHL«NBRLOL 0694 

GO TO 200 0695 

C THIS IS AN INTERNAL SUBROUTINE WHICH, GIVEN 0696 

C TOP = VALUE AT TOP OF SCOPE (IN Y UNITS) 0697 

C BOTTOM « VALUE AT BOTTOM OF SCOPE (IN Y UNITS) 0698 

C FINDS 0699 

C 8RL0U * Y VALUE FOR LOWEST UNLABELED BAR 0700 

C DBRLOU » Y INCREMENT BETWEEN UNLABELED BARS 0701 

C BRLOL = Y VALUE FOR LOWEST LABELED BAR 0702 

C DBRLOL = Y INCREMENT BETWEEN LABELED BARS 0703 

C NBRLOL » INTEGER TO PLOT NEXT TO LOWEST LABELED BAR 0704 

C (MAX 3 DIGITS PLUS SIGN) 0705 

C NEXP » POSITIVE OR NEGATIVE INTEGER TO PLOT AS EXPONENT 0706 

C (MAXIMUM 2 DIGITS PLUS SIGN) 0707 

C NCONST » POSITIVE OR NEGATIVE INTEGER TO ADD TO LABELS 0708 

C * NO. THOUSANDS TO BE ADDED TO LABELS 0709 

C (MAX 5 DIGITS PLUS SIGN) 0710 

C THE INCREMENTS FOUND WILL BE SUCH THAT THE TOTAL NO, OF CHECK MARKS 0711 

C WILL BE BETWEEN 20 AND 50 0712 

C (LOOP ALSO USED IN X DIRECTION) 0713 

C FIRST OF ALL FIND THE CONSTANTS WHICH WOULD RESULT IF 0714 

C DATA RANGED FROM 0 TO (TOP-BOTTOM) 0715 

C INITIALIZE 0716 

21 DATMAX=TOP-BOTTOM 0717 

NCONST=0 0718 

NBRLOL=0 0719 

BRLOU«0. 0720 

BRLOL=0. 0721 

C BEGIN BY FINDING NEXP AND DBRLOL= 10**NEXP SUCH THAT 0722 

C 10„»*NEXP LSTHN OATMAX LSTHN= 10.**(NEXP+1) 0723 

C SET TRIAL NEXP 0724 

C (THE CONST IS LOG, TO BASE 10, OF E=2. 718281828) 0725 

NEXP=0. 43429448*L0GF ( DATMAX ) 0726 

IF(DATMAX-l.O) 33,34,34 0727 

33 NEXP=NEXP-l 0728 

34 DBRL0L=10.**NEXP 0729 
C SET DBRLOU ACCORDING TO HOW MANY TIMES DBRLOL GOES INTO DATMAX 0730 

NTMS= DATMAX/ DBRLOL 0731 

IF(NTMS-l) 60,60,62 0732 
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C NTMS IS it OR 0 (MEANS DBRLOL* DATMAX PLUS EPSILON) 0733 

60 NEXP=NEXP^-i 0734 

DBRLOL=DBRLOL/10. 0735 

DBRL0U=DBRL0L/2. 0736 

GO TO 70 0737 

C IS NTMS 2,3, OR GREATER 0738 

62 IF(NTMS-3) 64,64,65 0739 

C 2 OR 3 0740 

64 DBRL01NDBRL0L/10. 0741 
GO TO 70 0742 

C 4,5. ..9, OR 10 ( DBRLOL= DATMAX/ 10. MINUS EPSILON) 0743 

65 DBRL0U=DBRL0L/5. 0744 
70 CONTINUE 0745 

B ONE^l 0746 

B 0NEK*1750 0747 

NTIMS=XFIXMF ( 0 , BOTTOM/ DBRLOL ) 0748 

IF ( BOTTOM) 78,99,74 0749 

74 IF ( DBRLOL*FLOATMF ( NT IMS ) -BOTTOM ) 76,78,76 0750 

76 NTIMS^NTIMS+IONE 0751 

78 NBRLOL-NTIMS 0752 

BRLOL=DBRLOL*FLOATMF ( NT IMS ) 0753 

BRLOU=BRLOL 0754 

80 IF ( BRLOU-BOTTOM) 84,86,82 0755 

82 BRLOU=BRLOU-DBRLOU 0756 

GO TO 80 0757 

84 BRL0U=BRL0U+DBRL0U 0758 

86 IF ( NBRLOL ) 88,98,94 0759 

C NEG 0760 

88 IF ( NBRLOL+ I ONEK ) 90,90,99 0761 

90 NCONST=NCONST-IONE 0762 

NBRL0L-NBRL0L+ IONEK 0763 

GO TO 88 0764 

C POS 0765 

94 IF (NBRLOL-IQNEK) 99,96,96 0766 

96 NCONST=NCONST+IONE 0767 

NBRLOL=NBRLOL— I ONEK 0768 

GO TO 94 0769 

98 NBRLOL=0 0770 

99 NCONST=*XF I XF ( FLOAT MF ( NCONST ) ) 0771 
NBRLOL-XF I XF ( FLOATMF ( NBRLOL ) ) 0772 
GO TO ISTOUT, (460,470) 0773 

C THIS IS AN INTERNAL SUBROUTINE WHICH, GIVEN 0774 

C NEXP = POSITIVE OR NEGATIVE INTEGER TO PLOT AS EXPONENT 0775 

C (MAX 2 DIGITS PLUS SIGN) 0776 

C NCONST ' POSITIVE OR NEGATIVE INTEGER TO BE ADOED TO LABELS 0777 

C (MAX 5 DIGITS PLUS SIGN) 0778 

C VORH = 1.0 FOR VERTICAL, = 0.0 FOR HORIZONTAL 0779 

C PLOTS THE SCALE CONVERSION FIELD (VERTICAL OR HORIZONTAL) AS FOLLOWS 0780 

C IF NCONST * 0 IN MAGNITUDE THEN 0781 

C A. NO CONVERSION FIELD IS PLOTTED IF NEXP IS ALSO = 0 0782 

C B. IF NEXP = 1 IT PLOTS 0783 

C (MULTIPLY INDICATED UNITS BY 10) 0784 

C C. OTHERWISE IT PLOTS NEXP 0785 

C (MULTIPLY INDICATED UNITS BY 10 ) 0786 

C IF NCONST IS NON-ZERO IT PLOTS 0787 

C ( (ADD NCONSTOOO TO UNITS 0788 

C AND A. IF NEXP =0 IT ADDS A RIGHT ) 0789 

C B. IF NEXP = I IT ADDS 0790 

C AND MULT BY 10) 0791 

C C. OTHERWISE IT ADDS 0792 

C NEXP 0793 

C AND MULT BY 10 ) 0794 

C FIRST CHECK STRAIGHT EXIT FOR NCONST=NEXP=0 0795 

520 IF (NCONST) 531,522,531 0796 

522 IF (NEXP) 524,599,524 0797 

C NCONST IS ZERO, NEXP IS NOT, CHECK HOR OR VERT 0798 

524 IF (VORH) 528,526,528 0799 

C HORIZONTAL 0800 

526 CALL DISPLA 0801 
PRINT 527 0802 

527 F0RMAT(46H2SH144,5, ( MULTIPLY INDICATED UNITS BY 10) 0803 
GO TO 542 0804 

C VERTICAL 0805 

528 CALL DISPLA 0806 
PRINT 529 0807 
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529 F0RMAT(47H2SV7i,120, ( MULTIPLY 


INDICATED UNITS BY 10! 


0808 


GO TO 542 








0809 


NCONST IS NOT ZERO , CHECK HOR OR 


VER 






0810 


531 IE (VORH) 537,532,537 








0811 


HORIZONTAL. CHECK NEXP = 0 








0812 


532 IF (NEXP) 535,533,535 








0813 


533 CALL DISPLA 








0814 


PRINT 534, NCONST 








0815 


534 F0RMAT(13H2SH250,5,(ADD,1I6, 


13H000 


TO 


UNITS)) 


0816 


GO TO 599 








0817 


535 CALL DISPLA 








0818 


PRINT 536, NCONST 








0819 


536 FORMAT( 13H2SH144,5, (ADD, 116, 


27H000 


TO 


UNITS AND MULT BY 10) 


0820 


GO TO 542 








0821 


VERTICAL WITH NCONST NOT = 0. CHECK NEXP 


» 0 


0822 


537 IF (NEXP) 540,538,540 








0823 


538 CALL DISPLA 








0824 


PRINT 539, NCONST 








0825 


539 F0RMAT(14H2SV71*300, ( ADD,1I6 


,13H000 


TO 


UNITS)) 


0826 


GO TO 599 








0827 


540 CALL DISPLA 








0828 


PRINT 541, NCONST 








0829 


541 F0RMAT(14H2SV7l,120, (ADD, 116 


,27H000 


TO 


UNITS AND MULT BY 10) 


0830 


GO TO 542 








0831 


THIS PORTION OF THE INTERNAL ROUTINE FILLS 


IN THE RIGHT END 


0832 




NEXP 






0833 


OF SCALE FIELD = ) IF NEXP = 1, 


) 


OTHERWISE 


0834 


(NOTE PROGRAM DOES NOT GET HERE 


IF NEXP 




0) 


0835 


FIRST CHECK HORIZONTAL OR VERTICAL 






0836 


542 IF (VORH) 583,548,583 








0837 


HORIZONTAL (UP TO STATEMENT 583) 








0838 


CHECK NEXP = 1 








0839 


548 IF (NEXP-i) 554,572,554 








0840 


FILL IN NEXP ACCORDING TO HOW MANY DIGITS 


INVOLVED (INCLUDING SIGNI 


0841 


554 IF (NEXP) 556,558,558 








0842 


TWO OR THREE 








0843 


556 IF (NEXP+10) 568,568,564 








0844 


ONE OR TWO 








0845 


558 IF (NEXP-10) 560,564,564 








0846 


ONE DIGIT EXPONENT 








0847 


560 CALL DISPLA 








0848 


PRINT 562, NEXP 








0849 


562 FORMAT ( 10H2SH92 1 , 20 , , 1 1 1 ) 








0850 


GO TO 572 








0851 


TWO DIGIT EXPONENT 








0852 


564 CALL DISPLA 








0853 


PRINT 566, NEXP 








0854 


566 FORMAT( 10H2SH921 ,20, , 112) 








0855 


GO TO 572 








0856 


THREE DIGIT EXPONENT 








0857 


568 CALL DISPLA 








0858 


PRINT 570, NEXP 








0859 


570 FORMAT ( 10H2SH92 1 , 20 , , 1 1 3 ) 








0860 


FILL IN RIGHT PAREN AND LEAVE 








0861 


572 CALL DISPLA 








0862 


PRINT 574 








0863 


574 FORMAT ( 10H2SH984, 5, ) ) 








0864 


GO TO 599 








0865 


FILL IN EXPONENT BUSINESS FOR VERTICAL 


FIELD 


0866 


CHECK FOR NEXP » 1 








0867 


583 IF (NEXP-1) 585,594,585 








0868 


FILL IN NEXP ACCORDING TO NUMBER 


OF DIGITS 




0869 


585 IF (NEXP) 586,587,587 








0870 


586 IF (NEXP+10) 593,593,592 








0871 


587 IF (NEXP-10) 590,592,592 








0872 


ONE DIGIT 








0873 


590 CALL DISPLA 








0874 


PRINT 591, NEXP 








0875 


591 F0RMAT(10H2SV61,897, ,111) 








0876 


GO TO 594 








0877 


TWO DIGITS 








0878 


592 CALL DISPLA 








0879 


PRINT 5920, NEXP 








0880 


5920 F0RMAT(10H2SV61,897,,1I2) 








0881 


GO TO 594 








0882 
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C THREE DIGITS 0883 

593 CALL DISPLA 0884 
PRINT 5930 t NEXP 0885 

5930 F0RMAT(10H2SV6l,897, ,113) 0886 

C FILL IN RIGHT PAREN 0887 

594 CALL DISPLA 0888 
PRINT 595 0889 

595 FORMAT ( 11H2SV71 ,960, ) ) 0890 
C EXIT FROM INTERNAL SUBROUTINE 0891 

599 GO TO ISCOUT, (462,472) 0892 

C THIS IS THE FRAME PLOTTING LOOP 0893 

C 0894 

C SEQUENCE OF EVENTS IS 0895 

C PLOT TITLE 0896 

C PLOT PAGE NO. 0897 

C PLOT X AXIS IF IT OCCURS ON THIS FRAME 0898 

C PLOT BOX 0899 

C PLOT VERTICAL CHECK MARKS AND LABELS 0900 

C PLOT HORIZONTAL CHECK MARKS AND LABELS 0901 

C IF THERE IS DATA FOR SOLID CURVE 0902 

C A. GET AND SCALE DATA SUBSETS FOR THIS FRAME 0903 

C B. USE HSTPLT TO PLOT THEM 0904 

C IF THERE IS DATA FOR DOTTED CURVE 0905 

C A. GET AND SCALE DATA SUBSETS FOR THIS FRAME 0906 

C 8. USE HSTPLT TO PLOT THEM 0907 

C IF MORE DATA, RESET, CALL FRAME, RETURN TO PLOT TITLE ABOVE 0908 

C IF NOT, EXIT 0909 

C IMPORTANT PARAMETERS OF THE FRAME LOOP (MOSTLY SCOPE UNITS) 0910 

C 0911 

C VLPOS IS X COORD OF LEFT VERTICAL FLTG PT 0912 

C VRPOS IS X COORD OF RIGHT VERTICAL 0913 

C HBPOS IS Y COORD OF BOTTOM LINE 0914 

C HTPOS IS Y COORD OF TOP LINE 0915 

C VUORG IS Y COORD OF FIRST UNLABELED CHECK MARK ON VERTICAL AXIS (0*0 0916 

C MEANS NONE) 0917 

C VUDEL IS Y INCREMENT OF UNLABELED CHECK MARK ON VERTICAL AXIS (0.0 0918 

C MEANS NONE) 0919 

C VLORG IS Y COORD OF FIRST LABELED CHECK MARK ON VERTICAL AXIS 0920 

C VLDEL IS Y INCREMENT OF LABELED CHECK MARK ON VERTICAL AXIS 0921 

C INTVL IS FIRST INTEGER TO LABEL CHECK MARK ON VERTICAL AXIS 0922 
C HUORG TS X COORD OF FIRST UNLABELED CHECK MARK ON HOR. AXIS(0*0 MEANS 0923 
C HUDEL IS X INCREMENT OF UNLABELED CHECK MARK ON HOR. AXIS(0.0 MEANS NO 0924 

C HLORG IS X COORD OF FIRST LABELED CHECK MARK ON HOR AXIS 0925 

C HLDEL IS X INCREMENT OF LABELED CHECK MARK ON HOR AXIS 0926 

C INTHL IS FIRST INTEGER TO LABEL CHECK MARK ON HOR AXIS 0927 

C I PAGE IS PAGE NO TO PLOT UNITED 0928 

C IPGXZ IS THE PAGE NO. ON WHICH X=0 OCCURS { NEG IF NONE) 0929 

C XZER IS THE X COORD OF THE X=0 LINE (ON PAGE IT OCCURS ON) 0930 

C CONVK IS A CONVERSION CONSTANT 0931 

C CONVL IS A CONVERSION CONSTANT 0932 

C WHERE DATA (SCOPE UNITS) = CONVK + ( DATA( INPUT UN I TS ) ) *CONVL 0933 

C NOPPP IS THE NUMBER OF PTS PER PAGE (FRAME) TO PLOT (ARGUMENT) 0934 

C NN IS THE TOTAL NUMBER OF DATA PTS ( ARGUMENT ) 0935 

C NPLOTD IS THE NUMBER OF DATA POINTS PLOTTED SO FAR( INITIALIZED TO ZERO 0936 

C ICHANL(I) * BUFFER BLOCK WHICH FEEDS HSTPLT DATA 0937 

C IYSCLX * X COORD OF LEFT EDGE OF Y SCALE FIELD IN SCOPE UNITS 0938 

C IXSCLY * Y COORD OF LOWER EDGE OF X SCALE FIELD IN SCOPE UNITS 0939 

C HSTORG(I) 1=1,4 = X1,Y1,X2,YI AXIS SPEC FOR HSTPLOT 0940 

C AXIS = INDICATOR FOR HSTPL, =0.0 MEANS PLOT HOR AXIS, 0941 

C NDELX = DELTA X FOR PLOT » 2*»7 0942 

C NOPTP = NO OF POINTS TO PLOT ON EACH FRAME ( IN IT=MIN< NOPPP, NN) 0943 

C PLOT TITLE 0944 

200 IF (TITLE-DOLARS) 2006,2002,2006 0945 

2002 DO 2004 1=1,8 0946 

J=9-I 0947 

2004 HOLER(J)=TITLE( 1+32760) 0948 

GO TO 2010 0949 

2006 DO 2008 1=1,8 0950 

2008 HOLER(I)=TITLE(I) 0951 

2010 CALL DISPLA 0952 

PRINT 202, tH0LER(I),I=l,8) 0953 

202 FORMAT ( 10H2SH5 , 1000, 8A6 ) 0954 

CPLOT PAGE NO. 0955 

CALL DISPLA 0956 

PRINT 203, I PAGE 0957 
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203 FORMAT ( 12H2SH1 ,55,PAGE, 114) 0958 
C IF X AXIS OCCURS ON THIS PAGE, PLOT IT ALONG WITH CHECK MARKS I UNLABEL 0959 

IF ( IPAGE-IPGXZ) 209,204,209 0960 

C AXIS 0961 

204 CALL LINE ( XZER,HBPOS,XZER, HTPOS ) 0962 
IF (VUORG) 205,207,205 0963 

C UNLABELED 0964 

205 TEMP1=VU0RG 0965 
TEMP2=XZER~5.0 0966 
TEMP3=XZER+5.0 0967 

206 CALL LINE ( TEMP2 , TEMPI , TEMP3, TEMPI ) 0968 
TEMPl^TEMPl+VUDEL 0969 
IF(TEMPl-HTPOS) 206,206,207 0970 

C LABELEO CHECKS PLOTTED WITHOUT LABELS 0971 

207 TEMP1=VL0RG 0972 
TEMP2=XZER-10.0 0973 
TEMP3*XZER+8.0 0974 

208 CALL LINE ( TEMP2 , TEMPI , TEMP3 , TEMP 1 ) 0975 
TEMP1=TEMP1+VLD£L 0976 
IF ( TEMPl-HTPOS) 208,208,209 0977 

C PLOT BOX 0978 

209 CALL LI NE(VLP0S,H8P0S,VLP0S, HTPOS) 0979 
CALL LINE(VLPOS, HTPOS, VRPOS, HTPOS) 0980 
CALL LINE (VRPOS, HTPOS, VRPOS,HBPOS ) 0981 
CALL LINE(VRPOS,HBPOS,VLPOS,HBPOS) 0982 

C PLOT UNLABELED CHECK MARKS ON VERTICAL AXIS IF THERE ARE ANY 0983 

IF ( VUORG) 210,220,210 0984 

210 TEMP1=VU0RG 0985 
TEMP2=VLP0S+10.0 0986 
TEMP3=VRP0S-10.0 0987 

212 CALL LINECVLPOS, TEMPI, TEMP2, TEMPI) 0988 

CALL LINE(TEMP3, TEMPI, VRPOS, TEMPI) 0989 

TEMPI =TEM PI +VUOEL 0990 

IF (TEMPl-HTPOS) 212,212,220 0991 

C PLOT LABELED CHECK MARKS ON VERTICAL AXIS AND LABELS 0992 

220 TEMPI* VLORG 0993 

TEMP2=VLP0S+20.0 0994 

TEMP3=VRP0S-20.0 0995 

ITEMPl^INTVL 0996 

222 CALL LINEiVLPOS, TEMPI, TEMP2, TEMPI) 0997 

CALL LINE(TEMP3, TEMPI, VRPOS, TEMPI) 0998 

ITEMP2=TEMP1-10.0 0999 

CALL DSPFMT < 3H2SH, IYSCLX, ITEMP2,4H 114, FMT) 1000 

CALL DISPLA 1001 

PRINT FMT , I TEMPI 1002 

TEMP1=TEMP1+VLDEL 1003 

ITEMP1=1+ITEMP1 1004 

IF(TEMPl-HTPOS) 222,222,230 1005 

C PLOT UNLABELED CHECK MARKS ON HORIZONTAL AXIS IF THERE ARE ANY 1006 

230 IF (HUORG) 232,240,232 1007 

232 TEMP1=HU0RG 1008 

TEMP2=H3POS-10.0 1009 

TEMP3=HTP0S-10.0 1010 

234 CALL LINE(TEMP1,TEMP2,TEMP1,HBP0S) 1011 

CALL LINE (TEMPI, TEMP3, TEMPI, HTPOS) 1012 

TEMP1=TEMP1+HUDEL 1013 

IF (TEMP1-VRP0S) 234,234,236 1014 

C RESET CHECK MARK ORIGIN FOR NEXT FRAME 1015 

236 HU0RG=TEMP1-VRP0S+VLP0S 1016 

C PLOT LABELED CHECK MARKS ON HORIZONTAL AXIS AND LABELS 1017 

240 TEMP1=HL0RG 1018 

I TEMP1=INTHL 1019 

TEMP2«HBP0S-10«0 1020 

TEMP3=HBP0S+20.0 1021 

TEMP4*HTP0S-20.0 1022 

242 CALL LINE ( TEMPI, TEMP2, TEMPI, TEMP3) 1023 

CALL LINE (TEMPI, TEMP 4, TEMPI, HTPOS) 1024 

ITEMP2=TEMPl+8.0 1025 

CALL DSPFMT (3H2SV, ITEMP2, IXSCLY,4H 114, FMT) 1026 

CALL DISPLA 1027 

PRINT FMT, IT EM PI 1028 

IT£MP1 = 1-HTEMP1 1029 

TEMPI=TEMP1+HLDEL 1030 

IF (TEMP1-VRP0S) 242,242,250 1031 

C RESET CHECK MARK ORIGIN AND INTEGER LABEL FOR NEXT FRAME 1032 



•**•••*••*•«*•*»*****•*• PROGRAM LISTINGS ##♦»*****»•♦»#*»**»*»**♦ 

* GRAPH * * GRAPH ♦ 

•»»•*••*•»»*•*•»***»»**» #•**•***»#**•*****#**•#• 

<PAGE 15) ( PAGE 15) 

250 HL0RG=TEMP1-VRP0S+VLP0S 1033 

INTHL*ITEMP1 1034 

C IF THERE IS DATA FOR SOLID PLOTS, PLOT THEM ONE AT A TIME 1035 

C PUTTING AXIS ONLY ON FIRST ONE {AXIS PLOT FOR AXIS^O.O) 1036 

261 NSOL^O 1037 
TYPE=0.0 1038 

C INDEX FOR NEXT SERIES 1039 

262 NS0L=NS0L+1 1040 
C EXIT WHEN HIT ZERO ADDRESS 1041 

IFtlSOL(NSOL) ) 4,270,2630 1042 

C SET SERIES ADDRESS 1043 

2630 ISRCE*ISOL(NSOL)-NPLOTD 1044 

C SET AXIS OR NOT <FIRST ONLY) 1045 

IF (NSOL-l) 264,263,264 1046 

263 AXIS=0.0 1047 
GO TO 265 1048 

264 AXIS=1.0 1049 

265 ASSIGN 266 TO IPLTEX 1050 
GO TO 290 1051 

266 GO TO 262 1052 
C IF THERE IS DATA FOR DOTTED PLOTS, PLOT THEM ONE AT A TIME 1053 
C PUTTING AXIS ONLY ON FIRST ONE AND ONLY IF NO SOLID PLOTS WIRE MADE 1054 

270 NDOT=0 1055 

TYPE=l.O 1056 

272 ND0T=ND0T+1 1057 
IF ( IDOT(NDOT) ) 4,280,273 1058 

273 ISRCE=IDOT(NDOT)-NPLOTD 1059 
IFUSOLU)) 277,275,277 1060 

275 IF (NDOT-1) 277,276,277 1061 

276 AXIS=0.0 1062 
GO TO 278 1063 

277 AXIS^l.O 1064 

278 ASSIGN 279 TO IPLTEX 1065 
GO TO 290 1066 

279 GO TO 272 1067 
C SEE IF THERE IS MORE DATA YET TO PLOT (300 IS NO) 1068 

280 NPLOTD=NPLOTD+NOPPP 1069 
C INDEX THE PAGE NUMBER BY 1 1070 

IPAGE=IPAG£+1 1071 

IPAGE=XMODF< IPAGE, 1000) 1072 

IF ( NPLOTD-NN) 282,300,300 1073 

C IF MORE TO PLOT SET SO FIRST POINT ON NEXT FRAME WILL BE 1074 

C SAME AS LAST POINT ON PRESENT FRAME 1075 

282 NPL0TD=NPL0TD-1 1076 

C RESET NO OF POINTS TO BE PLOTTED ON NEXT FRAME <=NOPPP UNLESS NEXT IS 1077 

NOPTP=NOPPP 1078 

IF (NPLOTD+NOPPP-NN) 286,286,284 1079 

284 NOPTP^NN-NPLOTD 1080 

C READJUST INDEX FOR FIRST BAR ON NEXT FRAME 1081 

ITEMPl a IFRSTB 1082 

2840 ITEMP1*ITEMP1+ISKIPB 1083 
IF (ITEMP1-N0PPP) 2840,2841,2841 1084 

2841 IFRSTB-ITEMPl-NOPPP+1 1085 
C INDEX THE FILM AND RETURN TO PLOT TITLE ON NEXT FRAME 1086 

286 CALL FRAME 1087 

GO TO 200 1088 

C THIS IS AN INTERNAL SUBROUTINE W.HICH MOVES THE NEXT BLOCK OF 1089 

C DATA FROM A SPECIFIED SERIES INTO THE SPACE BLOCK ANCf 1090 

C SCALES IT FOR PLOTTING. THEN IT PLOTS IT. ISRCE DEFINES DATA. 1091 

C TYPE^O.O FOR SOLID, 1.0 DOTTED. AXIS^O.O FOR AXIS,«1.0 NO AXISJ 1092 

290 ISP^XLOCF(SPACE) 1093 

CALL MVBLOK(NOPTP, ISRCE, !SP) 1094 

CGO SCALE DATA AND THEN PLOT IT 1095 

CALL SCPSCL ( SPACE , NOPTP, YTOP, YBOT,CONVK,CONVL ) 1096 

CALL HSTPLTl NOPTP, SPACE, HSTORG, NDELX, TYPE, AX IS, IFRSTB, I SK IPBi 1097 

GO TO IPLTEX, (266,279) 1098 

C FINAL EXIT 1099 

300 SPACE(1)=0.0 1100 

310 RETURN 1101 

END 1102 
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• GRAPHX (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0153 

» LABEL 0001 

CGRAPHX 0002 

SUBROUTINE GRAPHX( I SOL , IDOT ,N, TITLE ,YUNI TS ,XUNI TS, YTOP , YBOT , 0003 

1 XMAX,XMIN,NOPPP, I PAGE, SPACE, NFRMZV) 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - GRAPHX 0008 
C SUBROUTINE GRAPH EXPANDED OVER ARBITRARY NO. OF VERTICAL FRAMES 0009 

C 0010 

C GRAPHX IS FUNCTIONALLY IDENTICAL TO SUBROUTINE GRAPH, 0011 

C EXCEPT THAT THE PLOTS ARE EXPANDED OVER AN ARBITRARILY 0012 

C SPECIFIED NO. OF FRAMES, NFRMZV, IN THE VERTICAL 0013 

C DIRECTION. (THE HORIZONTAL SCALE IS UNMODIFIED.) 0014 

C 0015 

C GRAPHX HAS 14 ARGUMENTS. THE FIRST 13 OF THESE ARE 0016 

C EQUIVALENT TO THE 13 ARGUMENTS OF GRAPH, AND THE 14TH 0017 

C ARGUMENT IS NFRMZV. THE ARGUMENT YTOP NOW REFERS TO 0018 

C THE UPPER EDGE OF THE TOP ROW OF FRAMES, AND YBOT NOW 0019 

C REFERS TO THE LOWER EDGE OF THE BOTTOM ROW OF FRAMES. 0020 

C 0021 

C LANGUAGE - FORTRAN II SUBROUTINE 0022 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME AND SCOPE) 0023 

C STORAGE - 123 REGISTERS 0024 

C SPEED - TAKES MAXIMUM OF NFRMZV TIMES AS LONG AS GRAPH 0025 

C AUTHOR - S.M. SIMPSON, APRIL 1963 0026 

C 0027 

C USAGE 0028 

C 0029 

C TRANSFER VECTOR CONTAINS ROUTINES - GRAPH, FRAME 0030 

C AND FORTRAN SYSTEM ROUTINES - NONE 0031 

C 0032 

C FORTRAN USAGE 0033 

C CALL GRAPHX ( I SOL, IDOT,N,TITLE, YUN ITS, X UNITS, YTOP, YBOT, 0034 

C 1 XMAX, XMIN, NOPPP , I PAGE, SPACE, NFRMZV) 0035 

C 0036 

C INPUTS 0037 

C 0038 

C ISOL, IDOT, SPACE HAVE SAME MEANING AS FOR GRAPH EXCEPT YTOP 0039 

C AND YBOT ARE AS DESCRIBED IN ABSTRACT. 0040 

C 0041 

C NFRMZV IS THE DESIRED NO. OF VERTICAL FRAMES 0042 

C MUST EXCEED ZERO AND BE LESS THAN 101 0043 

C 0044 

C OUTPUTS 0045 

C OUTPUTS ARE SIMILAR TO THOSE OF GRAPH WITH ONE 0046 

C ADDITIONAL ERROR FLAG. 0047 

C SPACE(l) « 2. IF NFRMZV IS ILLEGAL. 0048 

C 0049 

C EXAMPLES 0050 

C 0051 

C 1. SHOWING FOUR VECTORS PLOTTED ACROSS 4 FRAMES VERTICALLY. 0052 

C 0053 

C USAGE - DIMENSION Y 1 ( 600 ) , Y2 i 600 ) , Y3 ( 600 ) , Y4 ( 600) , I SOL ( 4) 0054 

C DIMENSION ID0T12) ,SPACE(300) 0055 

C PI2 = 2.0*3.14159265 0056 

C DO 10 1=1,600 0057 

C FLI » FLOATF ( I ) 0058 

C Y1(I) » .75 + .10*C0SF<FLI»PI2/10.) 0059 

C Y2 ( I ) « -.7 + FLI/250. 0060 

C Y3U) = C1.0-FLI/650.)»COSF(FLI»PI2/150.) 0061 

C 10 Y4(I) = -.75 0062 

C DO 20 1=426,549 0063 

C 20 Y4(I) * -.2 0064 

C ISOL(l) = XLOCF(Yl) 0065 

C IS0L(2) = XL0CF(Y2) 0066 

C IS0L(3) « XL0CF(Y4) 0067 

C IS0H4) = 0 0068 

C IDOT(l) « XLOCF ( Y3 ) 0069 

C IDOT { 2) * 0 0070 

C IPAGE = 1 0071 

C CALL GRAPHX( ISOL, IDOT, 600, 0072 

C 154H$S$$$$THIS IS THE TITLE AREA IN THE EXAMPLE OF G 0073 

C 2RAPHX , 0074 
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OUTPUTS 



348H$$$$$$ YUNITS AREA IN THE ILLUSTRATION OF GRAPHX 
4, 

548H$$$$i$ XUNITS AREA IN THE ILLUSTRATION OF GRAPHX 
6, 

7 1. 2, -.8, 600., 0., 201, I PAGE, SPACE* 4 ) 

TWELVE FRAMES ARE PRODUCED WHICH WHEN CUT AND PASTED 
TOGETHER APPEAR AS SHOWN BELOW. 




PROGRAM FOLLOWS BELOW, 



10 
20 



30 



60 



CHECK NFRM2V 

IF (NFRMZV) 20,20,10 
IF (NFRMZV-100) 30,30,20 
SPACE * 2.0 
GO TO 9999 
SET UP YTP, YBT , DELY FOR LOOP 

DELY * ( YTOP-YBOT) /FLOAT F( NFRMZV ) 
YTP = YTOP 
YBT * YTP-DELY 
PRODUCE NFRMZV ROWS OF OUTPUT 
DO 70 1=1, NFRMZV 

CALL GRAPHUSOL, I DOT , N, T ITLE, YUNI TS , XUN I TS, YTP, YBT, 
1 XMAX,XMIN,NOPPP, I PAGE, SPACE) 

IF U-NFRMZV) 60,70,70 
CALL FRAME 
YTP * YTP-DELY 
YBT * YBT-DELY 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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70 CONTINUE 
C EXIT 
9999 RETURN 
END 
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0150 
0151 
0152 
0153 
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* GRUP2 (SUBROUTINE) 10/1/64 LAST CARD IN DECK IS NO* 0140 

• LABEL OOOi 
CGRUP2 0002 

SUBROUTINE GRUP2 ( P, NDELX, DELX, XLO, YL IM, NWANT, IANS) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - GRUP2 0007 

C DIVIDES THE X AXIS INTO EQUALLY PROBABLE RANGES 0008 

C 0009 

C GRUP2 PERFORMS A PROCESS KNOWN AS THE PROBABILITY 0010 

C TRANSFORMATION WHEREBY A GIVEN PROBABILITY DENSITY IS 0011 

C TRANSFORMED INTO A RECTANGULAR DENSITY. 0012 

C 0013 

C THE PRINCIPAL INPUT IS A HISTOGRAM-TYPE PROBABILITY 0014 

C DISTRIBUTION FUNCTION P( I ) , 1= I. . .NDELX, WHERE P(I) = 0015 

C PROBABILITY DENSITY FOR THE RANDOM VARIABLE X FALLING IN 0016 

C THE I-TH RANGE OF X VALUES, WHERE ALL RANGES ARE OF EQUAL 0017 

C LENGTH DELX, AND THE LOWEST RANGE IS FROM XLO T© XLO+DELX. 0018 

C 0019 

C GRUP2 DIVIDES THE X AXIS INTO NWANT RANGES FROM XLO TO 0020 

C NDELX*DELX+XL0, EACH RANGE HAVING EQUAL PROBABILITY DELP* 0021 

C DELPHI. /FLOATF(NWANT). GRUP2 RETURNS THE X VALUES 0022 

C CORRESPONDING TO THE RANGES. THE DIVISION IS MADE BY 0023 

C INTEGRATING THE PROBABILITY DISTRIBUTION ALONG THE X AXIS. 0024 

C LINEAR INTERPOLATION IS MADE WHEN AN INTEGER MULTIPLE OF 0025 

C 1/NWANT LIES BETWEEN SUM UP TO J ANO J+l OF (P(I)»DELX). 0026 

C 0027 

C LANGUAGE - FORTRAN II SUBROUTINE 0028 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0029 

C STORAGE - 201 REGISTERS 0030 

C SPEED - 0031 

C AUTHOR - J.N. GALBRAITH 0032 

C 0033 

C USAGE 0034 

C 0035 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0036 

C AND FORTRAN SYSTEM ROUTINES - NONE 0037 

C 0038 

C FORTRAN USAGE 0039 

C CALL GRUP2 ( P, NDELX , DELX , XLO, YLIM,NWANT, IANS) 0040 

C 0041 

C INPUTS 0042 

C 0043 

C P(I) 1=1.. .NDELX IS THE PROBABILITY DISTRIBUTION DEFINED 0044 

C FROM XLO TO NDELX * DELX +XLO AND NORMALIZED SUCH THAT 0045 

C THE SUM FROM 1=1 TO NDELX OF P(I)*DELX =1. IF P(I) 0046 

C IS NORMALIZED SUCH THAT SUM CPU)) LESS THAN 1. BY MORE 0047 

C THAN .00001, AN ERROR MAY OCCUR WITH IANS=-4 . IF P( I ) 0048 

C IS NORMALIZED SUCH THAT SUM (P(I)) GRTHN 1*, THE YL IM 0049 

C WILL BE COMPUTED IN THE USUAL MANNER WITH NORMALIZATION 0050 

C ASSUMED = 1.0 . 0051 

C 0052 

C XLO IS LOWEST VALUE OF X FOR WHICH P(I) IS DEFINED. 0053 

C 0054 

C DELX IS THE INCREMENT IN X. 0055 

C MUST BE GRTHN 0. 0056 

C 0057 

C NDELX IS THE NUMBER OF INCREMENTS. 0058 

C MUST BE GRTHN I. 0059 

C 0060 

C NWANT IS THE NUMBER OF EQUALLY LIKELY DIVISIONS WANTED* 0061 

C MUST BE GRTHN I. 0062 

C 0063 

C OUTPUTS 0064 

C 0065 

C YLIM(I) I=1...NWANT+1 IS THE VECTOR OF X VALUES WHICH 0066 

C CORRESPOND TO EQUALLY LIKELY PROBABILITY DIVISIONS. 0067 

C (YLIM( 1) = XL0) , (YLIM(NWANT + 1)=XL0+FL0ATF(NDELX**DELXI. 0068 

C 0069 

C IANS = 0 NORMAL 0070 

C = -1 ILLEGAL NDELX 0071 

C = -2 ILLEGAL DELX 0072 

C = -3 ILLEGAL NWANT 0073 
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C * -4 WEIRD ERROR IP PROBABLY NOT PROPERLY NORMALIZED) 0074 

C 0075 

C EXAMPLES 0076 

C 0077 

C 1. INPUTS - ALL P=0. NDELX^l DELX=0. XL0=*0. NWANT*0 0078 

C OUTPUTS - ERROR I ANS » -1 0079 

C 0080 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT NDELX=20 0081 

C OUTPUTS - ERROR IANS = -2 0082 

C 0083 

C 3. INPUTS - SAME AS EXAMPLE 2 EXCEPT D£LX=.05 NWANT-l 0084 

C OUTPUTS - ERROR IANS= -3 0085 

C 0086 

C 4. INPUTS - PU...20) * l.,.7t.5fi.3»2.,1.9,.6».5f.A(.3 f .2».U1.5, 0087 

C 1.5,1.5, 1.5,1.5,.5,.5,2. NDELX=20 DELX*. 05 0088 

C XLO^O. NWANT=5 0089 

C OUTPUTS - YLIMU, ...,6) - 0. ,. 2125, . 35, .683 33, .8 166611. IANS«0 0090 

C 0091 

C 5. INPUTS - SAME AS EXAMPLE 4. EXCEPT XL0=20. 0092 

C OUTPUTS - YLIM(1,...,6) * 20. , 20. 2125, 20 . 35, 20.68333, 20. 81666, 21 . 0093 

C IANS-0 0094 

C 0095 

C 6. INPUTS - SAME AS EXAMPLE 5. EXCEPT DELX=.0005 0096 

C OUTPUT - ERROR IANS=-4 0097 

C 0098 

C 7. INPUTS - SAME AS EXAMPLE 5. EXCEPT 0ELX*100. 0099 

C OUTPUTS - YLIM{ 1,...,6) = 20. , 20 . 2, 20.4, 20. 6, 20. 8, 20* 20 IANS*0 0100 

C 0101 

DIMENSION P(200) ,YLIM<201) 0102 

C CHECK NDELX 0103 

IANS--1 0104 

IF(NDELX-l) 9999,9999,5 0105 

C CHECK DELX 0106 

5 I ANS=-2 0107 

IF ( DELX) 9999,9999,10 0108 

10 NUMl=NWANT-t 0109 

IANS=-3 0110 

IF1NUM1) 9999,9999,20 0111 

20 YLIM(1)=XL0 0112 

YL IM ( NWANT+ 1 )= XL 0+ FLOAT F ( NDELX ) *DELX 0113 

DELP*1./FL0ATF (NWANT ) 0114 

PTEST=DELP 0115 

ISTART'l 0116 

SUM^O 0117 

IANS=0 0118 

DO 100 J=l,NUMl 0119 

DO 50 I=ISTART, NDELX 0120 

DELTA*P(I )*DELX 0121 

SUM=SUM+DELTA 0122 

IF <SUM-.99999»PTEST) 50,60,70 0123 

50 CONTINUE 0124 

C ERROR- USED ALL P WITHOUT FINDING ALL YL IM . 0125 

GO TO 9777 0126 

60 YLIM(J+1)=FLQATF(I )*DELX+XLO 0127 

ISTART=I+1 0128 

GO TO 90 0129 

C INTERPOLATE 0130 

70 SUM=SUM-DELTA 0131 

FRACTX=( PTE ST-SUM) /DELTA 0132 

YL IM ( J+l ) =M FLOATF ( 1-1 ) +FRACTX ) *DELX+XL0 0133 

ISTART=I 0134 

90 PTEST=PTEST+DELP 0135 

100 CONTINUE 0136 

9999 RETURN 0137 

9777 IANS=-4 0138 

GO TO 9999 0139 

END 0140 



**»*•*••»«•»«*•»»«»••*•* PROGRAM LISTINGS #»#**»***»»»#♦»»«*»*»#»♦ 

* HALVL * * HALVL * 

#•**••»»••*•*•*»*•*••*** »***•••«*••***•*•«•«**»* 

REFER TO REFER TO 

DUBLX DUBLX 



#*•*#•***•*****»»***»*»« 
» HALVX * 
•*«*»•*»•»»•*•*»»«**»»*• 

REFER TO 
OUBLX 



##*#********#»*»♦*#**##* 

* HALVX * 
•***••******•»«*«*•***•* 

REFER TO 
DUBLX 



•••»»••*»•»***»»•«•«•«•• PROGRAM LISTINGS #»*♦»*»**♦*#»#»#*#*»###* 

« HLADJ » * HLADJ * 

*•»*••*••»••••*»•***#•** «•*****•*•*•••»»«#«•***• 



HLADJ (FUNCTION) 
FAP 



9/29/64 LAST CARD IN DECK IS NO. 



♦HLADJ 



COUNT 
LBL 
ENTRY 
ENTRY 



100 
HLADJ 

HLADJ F(HOL) 
HRADJ F(HOL) 



ABSTRACT 



TITLE - HLADJ WITH SECONDARY ENTRY HRADJ 

HOLLERITH LEFT ADJUST OR RIGHT ADJUST FUNCTION 

HLADJ SHIFTS ITS HOLLERITH ARGUMENT LEFTWARDS UNTIL THE 
LEADING CHARACTER IS NON-BLANK, SPACES ARE INSERTED IN 
POSITIONS VACATED. NO ACTION IF ARGUMENT IS AfeL SPACES. 

HRADJ IS THE RIGHT SHIFTING ANALOG OF HLADJ. 



» LANGUAGE 

* EQUIPMENT 
» STORAGE 

» SPEED 

* AUTHOR 



- FAP FUNCTIONS ( FORTRAN-I I COMPATIBLE) 

- 709 OR 7090 (MAIN FRAME ONLY) 

- 46 REGISTERS 



- S.M. SIMPSON JR., 
USAGE 



SEPTEMBER 1963 



» TRANSFER VECTOR CONTAINS ROUTINES - < NONE ) 
» AND FORTRAN SYSTEM ROUTINES - C NONE ) 

• 

* FORTRAN USAGE 

• HOLADJ = HLADJF(HOL) 
» HOLADJ = HRADJF(HOL) 



• INPUTS 
» 

* HOL 

* OUTPUTS 

» HOLAOJ 

• EXAMPLES 



6 HOLLERITH IN FORMAT ( 1 A6 ) 



LEFT OR RIGHT ADJUSTED FORM OF HOL 



» 1. INPUTS - H0L1 = H0L4 * 6HABCDEF, H0L3 = H0L6 = 6H 

» H0L2 * 6H BC DE , H0L5 * 6HAB DE , 

* USAGE - HI » HLADJF ( HOL 1 ) 

* H2 = HLAD JF ( H0L2 ) 

* H3 = HLADJF{ H0L3 ) 

* H4 = HRADJF ( H0L4 ) 
» H5 = HRAD JF ( H0L5 ) 
» H6 = HRAD JF { H0L6 ) 

* OUTPUTS - HI = 6HABCDEF H2 = 5HBC EF H3 * 6H 
» H4 = 6HABCDEF H5 = 6H AB DE H6 = 6H 

* PROGRAM FOLLOWS BELOW 



0110 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 



- NO TRANSFER 


VECTOR 




0056 


HTR 


0 XR4 




0057 


BCI 


1 » HLADJ 




0058 


PRINCIPAL ENTRY. HLADJ F(HOL) 




0059 


HLADJ STZ 


ZIFHL 




0060 


TRA 


SETUP 




0061 


SECOND ENTRY. HRADJ F < HOL ) 




0062 


HRADJ SXA 


ZIFHL, 4 




0063 


FIRST SPREAD 


OUT THE 6 CHARACTERS, 


THEN BRANCH ON ENTRY 


0064 


SETUP SXD 


HLADJ-2,4 




0065 


STO 


HOL 




0066 


XCA 






0067 


AXT 


6,4 




0068 


PXA PXA 


0,0 




0069 


LGL 


6 




0070 


SLW 


C+1,4 




0071 


TIX 


PXA, 4,1 




0072 


LDO 


HOL RESTORE 


HOL 


0073 


ZET 


ZIFHL 




0074 



••»•••«»«»•••••»«••»••** PROGRAM LISTINGS #«**#»******#»#****♦♦*#♦ 

• HLADJ * ♦ HLADJ * 

••»*•••••»•»*••••*»•*••» #•»#»**#•»»#»»•*♦♦♦♦»♦»» 
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C 





TRA 


RADJ 




0075 


LEFT 


ADJUST 


SEQUENCE 




0076 




AXT 


6,4 




0077 


CALHL 


CAL 


C+1,4 


(GETS CI FIRST) 


0078 




LAS 


SPACE 




0079 




TRA 


•♦2 




0080 




TRA 


RQL6 




0081 




TRA 


LEAVE 




0082 


RQL6 


RQL 


6 




0083 




TIX 


CALHL, 4,1 




0084 




TRA 


LEAVE 




0085 


RIGHT ADJUST 


SEQUENCE 




0086 


RADJ 


AXT 


1,4 




0087 


CALHR 


CAL 


C*l,4 


(GETS C6 FIRST) 


0088 




LAS 


SPACE 




0089 




TRA 


**2 




0090 




TRA 


RQL30 




0091 




TRA 


LEAVE 




0092 


RQL30 


RQL 


30 




0093 




TXI 


♦♦1,4,1 




0094 




TXL 


CALHR, 4, 6 




0095 


EXIT 








0096 


LEAVE 


XCA 




RESULT TO AC 


0097 




LXD 


HLADJ-2,4 




0098 




TRA 


1,4 




0099 


CONSTANTS, TEMPORARIES 




0100 


SPACE 


OCT 


000000000060 




0101 


ZIFHL 


PZE 


»* 


**=0 IF HLADJ, NON-ZERO IF HRADJ 


0102 




PZE 


»» 


CI (LEFTMUST CHARACTER) 


0103 




PZE 


*# 


C2 


0104 




PZE 


*« 


C3 


0105 




PZE 


• * 


C4 


0106 




PZE 


»* 


C5 


0107 




PZE 


** 


C6 


0108 


HOL 


PZE 


•* f ** f ** 




0109 




END 






0110 



•»•*•*•»»»*«»•***•»•»*** PROGRAM LISTINGS 

* HRADJ * 

**•»*•**»*»*•*****»••*•» 

REFER TO 
HLADJ 



***««**#****•»**••#••»*» 

# HRADJ » 
#**#»»»»####*»•♦#*##*»## 

REFER TO 
HLADJ 



»••»••*••••»*•»•*»•* PROGRAM LISTINGS #»•*#»#**#♦*»*»•*#*•#»»* 

HSTPLT * * HSTPLT * 

»**••»•••»•»•**••*•» *»*#****»*#*»»»#**♦»**#» 



* HSTPLT ( SUBROUTINE ) 9/29/64 LAST CARD IN DECK IS NO. 0345 

* FAP 0001 
♦HSTPLT 0002 

COUNT 350 0003 

LBL HSTPLT 0004 

ENTRY HSTPLT ( LNY, NY, ORG, NDELX, OOT , AX I S, I FRSTB, I SKI PB ) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - HSTPLT 0009 
» HISTOGRAM PLOTTING FOR SUBROUTINE GRAPH 0010 

* 0011 

* HSTPLT PLOTS THE INPUT DATA AS A HISTOGRAM OF SQL ID OR 0012 

* DOTTED LINES, A POINT IS THUS REPRESENTED AS A HORIZONTAL 0013 

* LINE OF LENGTH NDELX/128 SCOPE UNITS. THE FIRST AND LAST 0014 
» POINTS ARE 1/2 THIS LENGTH. THE ENDS OF THE HORIZONTAL 0015 
» BARS ARE CONNECTED WITH VERTICAL LINES TO MAKE THE 0016 

* HISTOGRAM. 0017 

* 0018 
« IF DESIRED, AN X AXIS WITH SHORT VERTICAL BARS AT 0019 
» REGULAR INTERVALS IS PLOTTED. THE INDEX OF THE FIRST BAR 0020 
» AND THE SPACING OF THE BARS ARE CONTROLLED BY INPUT 0021 
» ARGUMENTS. 0022 

* 0023 

* 0024 
» LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0025 
» EQUIPMENT - 709, 7090 WITH SCOPE 0026 
» STORAGE - 145 DECIMAL REGISTERS 0027 

* SPEED - FAST (OPTIMUM) 0028 

* AUTHOR - J.N. GALBRAITH 5/16/62 0029 
» 0030 

* USAGE 0031 

« 0032 

* TRANSFER VECTOR CONTAINS ROUTINES - LINEH, LINEV 0033 
» AND FORTRAN SYSTEM ROUTINES - NONE 0034 

* 0035 

* FORTRAN USAGE 0036 

* CALL HSTPLT (LNY, NY, ORG, NDELX, DOT, AXIS, IFRSTB, ISKIPB) 0037 
» 0038 

* INPUTS 0039 
» 0040 

* NYU) 1 = 1. ..LNY ARE FORTRAN II INTEGER DATA POINTS SCALED FOR 0041 
» SCOPE PRESENTATION. 0042 

* MUST BE GRTHN'O, LSTHN 1024 0043 
» 0044 
» LNY IS FORTRAN II INTEGER 0045 

* SHOULD BE LSTHN 200 FOR GOOD RESOLUTION 0046 

* 0047 

* ORG(I) 1=1. ..3 ARE FLOATING POINT NUMBERS GIVING THE X,Y 0048 

* COORDINATES OF THE AXIS AND THE X COORDINATES OF THE 0049 

* PLOTTED NY SERIES, ALL IN SCOPE UNITS 0050 

* ORG ( 1 ) =LEFT X COORDINATE OF AXIS 0051 

* THE FIRST HORIZONTAL (HALF) BAR, CORRESPONDING 0052 

* TO NY(1), IS PLOTTED SO ITS LEFT EDGE HAS X 0053 

* COORDINATE = ORG(l) 0054 

* 0RG(2)=Y COORDINATE FOR AXIS 0055 
» 0RG(3)*RIGHT X COORDINATE OF AXIS 0056 
« 0057 

* NDELX THE SPACING, IN SCOPE UNITS, BETWEEN SUCCESSIVE DATA 0058 

* POINTS MULTIPLIED BY I2»*7) 0059 

* IS FORTRAN II INTEGER 0060 

* 0061 

* DOT =0. SOLIO LINES PLOTTED 0062 
» NOT=0. DOTTED LINES PLOTTED 0063 
» 0064 
» AXIS =0. AXIS AND CROSSBARS ARE PLOTTED 0065 

* NOT*0. NO AXIS IS PLOTTED 0066 

* 006 7 

* IFRSTB IS THE INDEX OF THE FIRST OATA POINT FOR WHICH A 0068 

* CROSSBAR IS PLOTTED ON THE AXIS 0069 

* IS FORTRAN II INTEGER 0070 

* 0071 

* ISKIPB IS THE NUMBER OF INDICES WHICH ARE SKIPPED BETWEEN THE 0072 

* PLOTTED CROSSBARS 0073 



PROGRAM LISTINGS 



* HSTPLT 
(PAGE 2) 



* OUTPUTS 
» 

• EXAMPLES 

♦ 1. INPUTS 

* 2, INPUTS 



IS FORTRAN II INTEGER 
DATA PLOTTED ON SCOPE 



NYC 1... 10) =100, 100, 100, 100* 100, 100, 100, 100i 100, 100 
LNY=10 QRG( 1... 3) = 10., 20., 1010. NDEL X= 101*2**7 
DOT-0. AXIS=0. IFRSTB=3 ISKIPB=2 

SAME AS EXAMPLE 1. EXCEPT 

NY (1... 10)= 100, 180, 260, 340, 420, 500, 580, 660, 740# 820 
IFRSTB=1 ISKIPB-1 



OUTPUTS - FOR EXAMPLES I AND 2. 




* 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT 

* NYU... 10) = 100, 108,132, 172,228,300,388,484,612,748 

* D0T=1. AXIS=1. 
• 

* 4. INPUTS - SAME AS EXAMPLE 1. EXCEPT 

* NY ( 1... 10) =100, 101,108, 127, 164,225,316,443*612,829 

* AXIS=1. 



**«»***»•*»*•••**»«**•»* 
* HSTPLT * 
#»•••»•»**•**#•••**•***• 

(PAGE 2) 



0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 



•»•*»•»*••***»•****••*** 
• HSTPLT * 
•»•*•*••**»•*•*•**•**»•« 
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PROGRAM LISTINGS 



*»****»•••*•*«»*«•»•*»«« 

• HSTPLT * 
#******••*•#**•»•*#*»»«* 

(PAGE 3) 



OUTPUTS - FOR EXAMPLES 3 AND 4. 




* 5. INPUTS - SAME AS EXAMPLE 1. EXCEPT 

» NY( 1... 10) =100, 200, 200,300,300,500, 50,60,1000,10 



AXIS-U 



* 6. INPUTS - 



NY ( 1. . . 100) =500, 500, 500, 500, 500 1 
500,450,400,350,300, 
0, 10, 40, 90,160, 
1000,999,992,973,936, 
0, 6, 25, 57, 95, 
500,579,655,727,794, 
1000,024,042,119,092, 
865,667,432,112,346, 
301,755,427,874,444, 
290,402,491,269,463, 
LNY=100 0RG(U.3) = 10.,20., 1010. 
DOT^O. AXIS^l. 



OUTPUTS - FOR EXAMPLES 5 ANO 6* 



500,500, 
250,200, 
250,360, 
875,784, 
146,206, 
854,905, 
482,054, 
178,931, 
977,383, 
885,423, 
NOELX = 



500,500 
150,100 
490,640 
657,488 
273,345 
943,975 
272,048 
625,517 
988,218 
639,798 
10*2**7 



,500t 
, 50, 
,810, 
,271* 
,421, 
,994, 
,325, 
,627, 
,512, 
,363 




PZE 
BCI 

HSTPLT SXA 



1, HSTPLT 
BACK,1 



0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
0197 
0198 



••••**•••*»»•»*•»»*•»»•« PROGRAM 
* HSTPLT * 
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L ISTINGS #**#»*♦»*»*»***#*»*«♦*»» 
• HSTPLT * 
*••••*****»••••»••**••*» 

( PAGE 4) 





SXA 


BACK+1,4 




0199 




SXO 


HSTPLT-2,4 




0200 




ZET* 


5,4 


TEST DOT 


0201 




TRA 


DOT 


DOTTED 


0202 




CLA 


THREE 


SOLID 


0203 




STO 


MODE 




0204 


RET 


CLA 


3,4 


LOC ORG 


0205 




ADO 


ADONE 




0206 




STA 


OR1 




0207 




CLA* 


1,4 




0208 




SUB 


ONE 




0209 




STO 


END 




0210 




AOO 


ONE 




0211 




SUB* 


7,4 




0212 




STO 


INDEX+1 




0213 




CLA 


NOP 




0214 




STO 


INS 




0215 




CLA* 


4,4 




0216 




ARS 


7 




0217 




STO 


DEL 




0218 




AXT 


3,1 




0219 


OR1 


CLA 


** , I 


FIX ORG VECTOR 


0220 




UFA 


CONST 


COMPONENTS 


0221 




ANA 


coNsm 


STORE 


0222 




ALS 


18 


IN 


0223 




STO 


NORG+1,1 


NORG TO NORG-2 


0224 




TIX 


ORl,l,l 




0225 




CLA* 


6,4 




0226 




TNZ 


NOAX 




0227 




TSX 


$LINEH,4 




0228 




PZE 


NORG 




0229 




PZE 


NORG- I 




0230 




PZE 


NORG-2 




0231 




PZE 


THREE 




0232 




CLA 


NORG-l 




0233 




ADO 


F I FT 


FIFTEEN 


0234 




STO 


BARLIM 




0235 




LXA 


BACK+1,4 




0236 




CLA* 


7,4 


IFRSTB 


0237 




SUB 


ONE 




0238 




XCA 






0239 




MPY 


DEL 


* DEL 


0240 




ALS 


17 


(( IFRSTB-1)*NDELX)/128 


0241 




ADD 


NORG 




0242 




STO 


NPLTX 




0243 




CLA* 


8,4 




0244 




STD 


INDEX 




0245 




XCA 






0246 




MPY 


DEL 




0247 




ALS 


17 




0248 




STO 


SKIP 


ISKIPB*DEL 


0249 




AXT 


1,1 




0250 




TRA 


START 




0251 


BAR 


CLA 


SKIP 




0252 




ADD 


NPLTX 




0253 




STO 


NPLTX 




0254 


START 


TSX 


$LINEV,4 




0255 




PZE 


NPLTX 




0256 




PZE 


NORG-l 




0257 




PZE 


BARLIM 




0258 




PZE 


THREE 




0259 


INDEX 


TXI 


*+l ,1,** 




0260 




TXL 


BAR, 1 , ** 




0261 


NOAX 


LXA 


BACK+1,4 




0262 




CLA 


DEL 




0263 




ARS 


1 




0264 




STO 


DEL2 




0265 




ADD 


NORG 




0266 




STO 


NLSTX 




0267 




CLA 


NORG 




0268 




STO 


NFSTX 




0269 




CLA 


2,4 




0270 




STA 


SUB 




0271 




STA 


LDQ 




0272 




ADD 


ADONE 




0273 
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* HSTPLT * 
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♦ HSTPLT * 
#•••»•*****#•#•«•«**•••# 

(PAGE 5) 





STA 


BEGIN 


0274 




AXT 


It I 


0275 




TRA 


BEGIN 


0276 


LOOP 


CLA 


NLSTX 


0277 




STO 


NFSTX 


0278 




ADD 


DEL 


0279 




STO 


NLSTX 


0280 


BEGIN 


CLA 


»*,1 


0281 




STO 


NYBOT 


0282 




STO 


NYFST 


0283 


SUB 


SUB 


«», 1 


0284 




TZE 


HOR 


0285 


LDO 


LDQ 


**, I 


0286 




TMI 


NEXT 


0287 




CLA 


NYBOT 


0288 




STO 


NYTOP 


0289 




STO 


NYBOT 


0290 




TRA 


VERT 


0291 


NEXT 


STQ 


NYTOP 


0292 


VERT 


TSX 


$LINEV,4 


0293 




PZE 


NLSTX 


0294 




PZF 


NYBOT 


0295 




PZE 


NYTOP 


0296 




PZE 


MODE 


0297 


HOR 


TSX 


$L INEH,4 


0298 




PZE 


NFSTX 


0299 




PZE 


NYFST 


0300 




PZE 


NLSTX 


0301 




PZE 


MODE 


0302 




TXI 


•+1,1,1 


0303 


END 


TXL 


LOOP,l ,*» 


0304 


INS 


NOP 




0305 




CLA 


TRA 


0306 




STO 


INS 


0307 




XEC 


BEGIN 


0308 




STO 


NYFST 


0309 




CLA 


NLSTX 


0310 




STO 


NFSTX 


0311 




ADD 


DEL2 


0312 




STO 


NLS TX 


0313 




TRA 


HOR 


0314 


BACK 


AXT 


♦*,1 


0315 




AXT 


**,4 


0316 




TRA 


9,4 


0317 


DOT 


CLA 


EIGHT 


0318 




STO 


MODE 


0319 




TRA 


RET 


0320 


* 


CONSTANTS AND TEMPORARY STORAGE 


0321 


MODE 






0322 


DEL 






0323 


DEL? 






0524 


ONE 


PZE 


0,0,1 


0325 


ADONE 


PZE 


If 0,0 


0326 


THREE 


PZE 


0,0,3 


0327 


EIGHT 


PZE 


0,0,8 


0328 


F IF T 


PZE 


0,0,15 


0329 


CONST 


OCT 


233000000000 


0330 




OCT 


000000377777 


0331 




PZE 




0332 




PZF 




0333 


NORG 


PZE 




0334 


NYTOP 


EOU 


NORG 


0335 


NYBOT 


EQU 


NQRG-1 


0336 


NFSTX 


EQU 


NORG-2 


0337 


NPLTX 






0338 


NLSTX 


EQU 


NPLTX 


0339 


BARLIM 






0340 


NYFST 


EQU 


BARLIM 


0341 


SKIP 


PZE 


0 


0342 


NOP 


NOP 




0343 


TRA 


TRA 


BACK 


0344 




END 




0345 
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* HSTPLT-II * 
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* HSTPLT-II (SUBROUTINE) 9/Z9f6<* LAST CARD IN DECK IS NO. 0335 

* FAP 0001 
•HSTPLT-II 0002 

COUNT 350 0003 

LBL HSTPLT 0004 

ENTRY HSTPLT { LNY, NY, ORG , NDELX, DOT, AXt S, IFRSTB, I SKI PB ) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - HSTPLT-II 0009 

* BAR GRAPH PLOTTING FOR SUBROUTINE GRAPH 0010 
» 0011 
« HSTPLT PLOTS A GRAPH OF THE INPUT DATA AS VERTICAL LINES 0012 

* FROM A HORIZONTAL LINE. THE Y-COORDINATE OF THE 0013 

* HORIZONTAL LINE IS TAKEN AS THE FIRST OATA POINT. THEN 0014 

* ALL OTHER DATA IS PLOTTED RELATIVE TO THIS LINE. SINCE 0015 

* THE LAST POINT WOULD NORMALLY FALL ON THE EDGE OF THE 0016 

* DISPLAY BOX, IT IS PLOTTED 4 SCOPE-UNITS TO THE LEFT OF 0017 

* THE BOX BOUNDARY. 0018 

* 0019 

* HSTPLT, AS USED BY GRAPH, LIMITS THE COMBINED LENGTH 0020 

* OF ISOL AND IDOT TO 20 ENTRIES. 0021 

* 0022 

* LANGUAGE - FAP, SUBROUTINE {FORTRAN II COMPATIBLE) 0023 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME AND SCOPE) 0024 
» STORAGE - 188 REGISTERS 0025 

* SPEED - FAST (OPTIMUM) 0026 

* AUTHOR - R.A. WIGGINS, 9/5/62 0027 

* 0028 
» USAGE 0029 

* 0030 
» TRANSFER VECTOR CONTAINS ROUTINES - LINEH, LINEV 0031 

* AND FORTRAN SYSTEM ROUTINES - NONE 0032 

* 0033 

* FORTRAN USAGE 0034 

* CALL HSTPLT(LNY, NY, ORG, NDELX, DOT, AXIS, IFRSTB, ISKIPB) 0035 

* 0036 
» INPUTS 0037 

* 0038 

* NYU) I«1...LNY ARE FORTRAN II INTEGER DATA POINTS SCALED FOR 0039 
« SCOPE PRESENTATION. 0040 

* MUST BE GRTHN=0, LSTHN 1024 0041 

* 0042 

* LNY IS FORTRAN II INTEGER 0043 

* SHOULD BE LSTHN 200 FOR GOOD RESOLUTION 0044 
» 0045 
» ORG(I) 1-1. ..3 ARE FLOATING POINT NUMBERS GIVING THE X,Y 0046 

* COORDINATES OF THE AXIS AND THE X COORDINATES OF. THE 0047 
» PLOTTED NY SERIES, ALL IN SCOPE UNITS 0048 

* ORG ( 1 )=LEFT X COORDINATE OF AXIS AND FIRST NY POINT 0049 

* 0RG(2)=Y COORDINATE FOR AXIS 0050 

* 0RG(3 BRIGHT X COORDINATE OF AXIS 0051 

* 0052 

* NDELX THE SPACING, IN SCOPE UNITS, BETWEEN SUCCESSIVE DATA 0053 

* POINTS MULTIPLIED BY (2**7) 0054 

* IS FORTRAN II INTEGER 0055 

* 0056 

* DOT =0. SOLID LINES PLOTTED 0057 

* NOT=0. DOTTED LINES PLOTTED 0058 

* 0059 

* AXIS =0. THIS IS FIRST CURVE TO BE PLOTTEO FOR THIS FRAME 0060 

* NOT =0. THIS IS NOT THE FIRST CURVE FOR THIS FRAME 0061 

* SET = 1. IF HSTPLT IS NOT BEING USED BY GRAPH. 0062 

* 0063 

* IFRSTB IS A DUMMY ARGUMENT FOR THIS HSTPLT 0064 

* 0065 

* ISKIPB IS A DUMMY ARGUMENT FOR THIS HSTPLT 0066 

* 0067 

* OUTPUTS DATA PLOTTED ON SCOPE 0068 

* 0069 

* EXAMPLES 0070 

* 0071 

* 1. INPUTS - NYU. ..10) = 100, 100, 100, 100, 100, 100, 100, 100*100, 100 0072 

* LNY=10 0RG(1...3)=10.,20.,1010. NDELX=14222 0073 
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DOT=0. 
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AXIS=0. IFRSTB=3 ISKIPB=2 
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* 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT 

* NY( I... 10)* 100, 180,260, 340*420* 500,580,660,740,820 

* IFRSTB=1 ISKIP8=l 
* 

» OUTPUTS - FOR EXAMPLES 1 ANO 2. 




* 3* INPUTS - SAME AS EXAMPLE 1. EXCEPT 

* NY I 1... 10) = 100, 108, 132, 172t 228, 300, 388*484, 612, 748 
» D0T=1. AXIS=1. 

* 

* 4. INPUTS - SAME AS EXAMPLE 1. EXCEPT 

» NY ( 1... 10) = 100, 101, 108, 127, 164,225,316,443*612,829 

* AXIS=i. 
* 

* OUTPUTS - FOR EXAMPLES 3 AND 4. 




* 5. INPUTS 



- SAME AS EXAMPLE 1. EXCEPT 

NYC 10) =100, 200, 200, 300, 300, 500, 50, 60, 1000, 10 AXIS=1. 



0074 

0075 

0076 

0077 

0078 

0079 

0080 

0081 

0082 

0083 

0084 

0085 

0086 

0087 

0088 

0089 

0090 

0091 

0092 

0093 

0094 

0095 

0096 

0097 

0098 

0099 

0100 

0101 

0102 

0103 

0104 

0105 

0106 

0107 

0108 

0109 

0110 

0111 

0112 

0113 

0114 

0115 

0116 

0117 

0118 

0119 

0120 

0121 

0122 

0123 

0124 

0125 

0126 

0127 

0128 

0129 

0130 

0131 

0132 

0133 

0134 

0135 

0136 

0137 

0138 

0139 

0140 

0141 

0142 

0143 

0144 

0145 

0146 
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* 6. INPUTS - 



NY ( 1. • . 100) =500, 500, 500, 500 
500,450,400,350 
0, 10, 40, 90 
1000,999,992,973 
0, 6, 25, 57 
500,579,655,727 
1000,024,042,119 
865,667,432, 112 
301,755,427,874 



290,402,491,269 
r=100 ORG(1..3)=10.,20., 
f=0. AXIS^l. 



LNY= 
DOT 



OUTPUTS - FOR EXAMPLES 5 AND 6* 



500, 
300, 
160, 
936, 
95, 
794, 
092, 
346, 
444, 
,463, 
1010, 



500,500, 
250,200, 
250,360, 
875,784, 
146,206, 
854,905, 
482,054, 
178,931, 
977,383, 
885,423, 
NDELX* 



500,500 
150,100 
490,640 
657,488 
273,345 
943,975 
272,048 
625,517 
988,218 
639,798 
1293 



500, 
50, 
,810, 
271, 
421, 
994, 
,325, 
,627, 
,512, 
,363 




PZE 

BCI 1,HSTPLT 

HSTPLT SXD *-2,4 

SXA ADR, I 

SXA ADR+1,2 

• SET UP ADDRESSES 
CAL 3,4 

ADD =1B35 

STA ORG+1 

CAL 2,4 

ADD =1B35 

STA NY 

STA NYO 
» FIX ORGU-3) 

ORG AXT 3,1 

CLA **,1 

UFA =0233000000000 

ANA =0377777 

ALS 18 

STO IORG+1,1 

TIX ORG+1,1,1 

• DETERMINE WHAT IAXIS TO USE 
CLA K 

TNZ Al 

Bl CLA =IB17 

STO K 

PDX ,1 

STZ IFIRST 

CLA* 2,4 

STO IAXIS 

CLA IORG-1 

STO YORG 

TRA A4 
Al CLA* 6,4 



0147 
0148 
0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
C167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
0197 
0198 
0199 
0200 
0201 
0202 
0203 
0204 
0205 
0206 
0207 
0208 
0209 
0210 
0211 
0212 
0213 
0214 
0215 
0216 
0217 
0218 
0219 
0220 
0221 
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TNZ A2 0222 

CiA = 1B17 0223 

STO IFIRST 0224 

CLA NYL 0225 

SUB* 2,4 0226 

TNZ Bl 0227 

CLA YORG 0228 

SUB IORG-1 0229 

TNZ Bl 0230 

CLA = 1B17 0231 

STO K 0232 

TRA A4 0233 

A2 CLA IFIRST 0234 

TNZ A3 0235 

CLA K 0236 

ADO =1817 0237 

STO K 0238 

PDX ,1 0239 

CLA* 2,4 0240 

STO IAXIS+1,1 0241 

TRA A4 0242 

A3 CLA K 0243 

ADD = 1B17 0244 

STO K 0245 

PDX ,1 0246 

CLA NYL+1,1 0247 

SUB* 2,4 0248 

TZE A4 0249 

CLA* 2,4 0250 

STO IAXIS+1,1 0251 

STZ IFIRST 0252 

A4 CLA* 1,4 0253 

PDX ,2 0254 

STD A6+1 0255 

SUB = 1817 0256 

STD A6 0257 

► PLOT HORIZONTAL AXIS 0258 

NY CLA **,2 0259 

STO NYL+1,1 0260 

CLA IAXIS+1 0261 

PXA ,1 0262 

SSM 0263 

ADD *-3 0264 

STA *+3 0265 

TSX $LINEH,4 0266 

TSX IORG 0267 

TSX ** 0268 

TSX IORG-2 0269 

TSX =4817 0270 

PLOT VERTICAL LINES 0271 

LXD HSTPLT-2,4 0272 

CLA* 5,4 0273 

TZE *+4 0274 

CLA =8B17 0275 

STO DOT 0276 

TRA *+3 0277 

CLA =4B17 0278 

STO DOT 0279 

CLA IAXIS+1, 1 0280 

STO IA1 0281 

CLA* 4,4 0282 

ARS 7 0283 

STO NDELX 0284 

CLA IORG 0285 

STO IX 0286 

AXT 2,2 0287 

B2 CLA IX 0288 

ADD NDELX 0289 

STO IX 0290 

STD 1X1 0291 

NYO CLA **,2 0292 

STO NYl 0293 

SUB IA1 0294 

TZE A6-1 0295 

TMI A5 0296 
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TSX 


$LI NEVt 4 


0297 




TSX 


1X1 


0298 




TSX 


I Al 


0299 




TSX 


NY1 


0300 




TSX 


DOT 


0301 




TRA 


A6-1 


0302 


A5 


TSX 


$LIN£V»4 


0303 




TSX 


1X1 


0304 




TSX 


NY1 


0305 




TSX 


I Al 


0306 




TSX 


DOT 


0307 




TXI 


•♦1,2,1 


0308 


A6 


TXL 


B2»2,*« 


0309 




TXL 


«+2 ,2 , «* 


0310 




TRA 


A7 


0311 




CLA 


IX 


0312 




SUB 


=4B17 


0313 




STO 


IX 


0314 




TRA 


B2 


0315 


A7 


LXD 


HSTPLT-2,4 


0316 


ADR 


AXT 


*«t 1 


0317 




AXT 


»«,2 


0318 




TRA 


9,4 


0319 




BES 


3 


0320 


I ORG 


PZE 




0321 


K 


PZE 




0322 


IF IRST 


PZE 




0323 


YORG 


PZE 




0324 


DOT 


PZE 




0325 


IA1 


PZE 




0326 


NDELX 


PZE 




0327 


IX 


PZE 




0328 


1X1 


PZE 




0329 


NY1 


PZE 




0330 




BES 


19 


0331 


IAXIS 


PZE 




0332 




BES 


19 


0333 


NYL 


PZE 




0334 




END 




0335 



*•*»*•••*•*•»»*•******•• 

* HSTPLT -III (709) * 



PROGRAM LISTINGS 



#»••»***•*••«••*»*»•*••• 

* HSTPLT -III (709) * 
#•••*»*#•••»*•**«»•**»»* 



* HSTPLT-IU ( 709 ) ( SUBROUTINE ) 9/29/64 LAST CARD IN DECK IS NO, 0437 



* FAP 0001 
♦HSTPLT -III (709) 0002 

COUNT 400 0003 

LBL HSTPLT 0004 

ENTRY HSTPLT ( LNY, NY,ORG,NDELX, DOT, AXISt IFRSTB. ISKIPB ) 0005 

» 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - HSTPLT-III (709) 0009 

* CUBIC CURVE SCOPE PLOTTING FOR SUBROUTINE GRAPH 0010 

* 0011 

* HSTPLT PLOTS THE INPUT DATA AS DARKENED POINTS WITH CUBIC 0012 

* CURVES FITTED BETWEEN THE POINTS. EXCEPT AT THE ENDS OF 0013 

* THE DATA, THE NEAREST FOUR DATA POINTS ARE USED FOR 0014 

* DETERMINING THE CUBIC. AT THE END OF THE DATA SEQUENCE 0015 

* THE NEXT POINT IS ASSUMED TO BE THE SAME AS THE FINAL 0016 

* POINT. IF DESIRED, AN X-AXIS WITH SHORT BARS SPACED AT 0017 

* REGULAR INTERVALS IS PLOTTED. THE BEGINNING POINT AND THE 0018 
» SPACING OF THE BARS ARE CONTROLLED BY INPUT ARGUMENTS. 0019 

* 0020 

* LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0021 

* EQUIPMENT - 709 (MAIN FRAME AND SCOPE) 0022 

* STORAGE - 256 REGISTERS 0023 

* SPEED - FAST (OPTIMUM) 0024 

* AUTHOR - R.A. WIGGINS, 9/5/62 0025 

* 0026 

* USAGE 0027 

* 0028 
« TRANSFER VECTOR CONTAINS ROUTINES - LINEH 0029 

* AND FORTRAN SYSTEM ROUTINES - NONE 0030 

* 0031 

* FORTRAN USAGE 0032 

* CALL HSTPLT(LNY,NY,ORG,NDELX,DOT,AXIS, IFRSTB, ISKIPB) 0033 

* 0034 

* INPUTS 0035 

* 0036 

* NY(I) 1*1... LNY ARE FORTRAN II INTEGER DATA POINTS SCALED FOR 0037 

* SCOPE PRESENTATION. 0038 

* MUST BE GRTHN-O, LSTHN 1024 0039 

* 0040 

* LNY IS FORTRAN II INTEGER 0041 

* SHOULD BE LSTHN 200 FOR GOOD RESOLUTION 0042 

* 0043 

* ORG(I) 1=1.. .3 ARE FLOATING POINT NUMBERS GIVING THE X,Y 0044 

* COORDINATES OF THE AXIS AND THE X COORDINATES OF THE 0045 
» PLOTTED NY SERIES, ALL IN SCOPE UNITS 0046 

* ORG ( 1 ) =LEFT X COORDINATE 0047 

* 0RG(2)=Y COORDINATE FOR AXIS 0048 

* 0RG(3)=RIGHT X COORDINATE 0049 

* 0050 

* NDELX THE SPACING, IN SCOPE UNITS, BETWEEN SUCCESSIVE DATA 0051 

* POINTS MULTIPLIED BY (2**7) 0052 

* IS FORTRAN II INTEGER 0053 

* 0054 

* DOT =0. SOLID LINES PLOTTED 0055 

* NOT=0. DOTTED LINES PLOTTED 0056 

* 0057 

* AXIS =0. AXIS AND CROSSBARS ARE PLOTTED 0058 

* NOT=0. NO AXIS IS PLOTTED 0059 

* 0060 

* IFRSTB IS THE INDEX OF THE FIRST DATA POINT FOR WHICH A 0061 

* CROSSBAR IS PLOTTED ON THE AXIS 0062 

* IS FORTRAN II INTEGER 0063 

* 0064 

* ISKIPB IS THE NUMBER OF INDICES WHICH ARE SKIPPED BETWEEN THE 0065 

* PLOTTED CROSSBARS 0066 

* IS FORTRAN II INTEGER 0067 

* 0068 

* OUTPUTS DATA PLOTTED ON SCOPE 0069 
» 0070 

* EXAMPLES 0071 

* I. INPUTS - NYU.. .10)^100, 100, 100, 100, 100, 100, 100, 100# 100, 100 0072 

* LNY^IO ORG( 1.. .3)^10. ,20. ,1010. NDELX=14222 0073 
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• 00T=0. AXIS=0. IFRSTB»3 ISKIPB=2 
• 

* 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT 

• NY < 1 . . i 10 )= 100 , 180, 260# 340, 420, 500, 580, 660#740, 820 

* IFRSTB=1 ISKIPB=1 
* 

» OUTPUTS - FOR EXAMPLES 1 AND 2. 




* 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT 

» NYU... 10)= 100 ,108,132,172,228,300,388,484,612,748 

* D0T=1. AXIS'l. 
• 

* 4. INPUTS - SAME AS EXAMPLE 1. EXCEPT 

* NY ( I.. i 10)* 100, 101, 108, 127, 164,225,316,443,612,829 
» AXIS=1. 

• 

* OUTPUTS - FOR EXAMPLES 3 AND 4. 




* 5. INPUTS 



- SAME AS EXAMPLE I. EXCEPT 

NY ( 1... 10) =100, 200, 200, 300, 300, 500, 50, 60, 1000,10 AXIS=li 



0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
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» 6. INPUTS - 



NY{ 1.. . 100) =500, 500, 500, 500 
500,450,400,350 
n 10, 40, 90 



» HSTPLT -III (709) • 
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LNY=100 
DOT^O. 



009|OOffH3^| Lid 

301,755,427,874 
290,402,491,269 
ORG< U.3) = 10.,20., 
AXIS=l. 



,500, 
300, 
,160, 
936, 
95, 
794, 
,092, 
346, 
444 
463 
1010 



500,500 
250,200, 
250,360, 
875,784, 
146,206, 
854,905, 
482,054, 
178,931, 
977,383, 
885,423, 
NOELX- 



500,500 
150,100 
490,640 
657,488 
273,345 
943,975 
272,048 
625,517 
988,218 
639,798 
1293 



,500, 
50, 
,810, 
271, 
,421, 
,994, 
,325, 
,627, 
,512, 
,363 



OUTPUTS - FOR EXAMPLES 5 AND 6. 




ORG 



0147 
0148 
0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 



PZE 




0188 


BCI 


1, HSTPLT 


0189 


SXD 


•-2,4 


0190 


SXA 


ADR, 1 


0191 


SXA 


ADR+1,2 


0192 


CAL 


3,4 


0193 


ADO 


= 1835 


0194 


STA 


ORG 


0195 


FIX 


ORG (1-4) 


0196 


AXT 


3,1 


0197 


CLA 


**,1 


0198 


UFA 


=0233000000000 


0199 


ANA 


=0377777 


0200 


ALS 


18 


0201 


STO 


IORG+1,1 


0202 


TIX 


ORG, 1,1 


0203 


CLA» 


4,4 


0204 


ARS 


7 


0205 


STO 


NDELX 


0206 


00 HORIZONTAL AXIS IF AXIS=0 


0207 


CLA* 


6,4 


0208 


TNZ 


A2 


0209 


TSX 


$LINEH,4 


0210 


TSX 


IORG 


0211 


TSX 


IORG-1 


0212 


TSX 


IORG-2 


0213 


TSX 


=4B17 


0214 


LXD 


HSTPLT-2,4 


0215 


LDQ 


NDELX 


0216 


MPY* 


7,4 


0217 


LLS 


17 


0218 


ADD 


IORG 


0219 


STO 


NX 


0220 


STD 


NX 1 


0221 
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LOQ 


NDELX 








0222 




MPY* 


8,4 








0223 




LLS 


\? 








0224 




STO 


NDELXl 








0225 




CLA» 


1»4 








0226 




PDX 


♦ 2 








0227 




CLA 


IORG-1 








0228 




ADD 


=12B17 








0229 




STD 


L00P1+4 








0230 




CLA« 


8,4 








0231 




STD 


Al 








0232 




LXO 


IORG-1,1 








0233 




SXA 


NX1,1 








0234 


L00P1 


WTV 










0235 




CPY 


NX1 








0236 




TXI 


•♦It It* 








0237 




SXA 


NXl,l 








0238 




TXL 


LOOPl,i,*» 








0239 




CLA 


NX 








0240 




AOD 


NDELXl 








0241 




STO 


NX 








0242 




STD 


NX I 








0243 


Al 


TIX 


LOOPl-2,2,** 








0244 




SET UP CONSTANTS FOR 


MAIN 


LOOP 




0245 


A2 


CLA* 


5,4 








0246 




TNZ 


•♦4 








0247 




CLA 


=4817 








0248 




STO 


DOT 








0249 




TRA 


*+3 








0250 




CLA 


=8817 








0251 




STO 


DOT 








0252 




CAL 


2,4 








0253 




STA 


NYADD 








0254 




ADD 


= 183$ 








0255 




STA 


A3 








0256 




CLA» 


1»4 








0257 




STD 


A10+1 








0258 




ADD 


= 1617 








0259 




STD 


Ail 








0260 




CLA 


IORG 








0261 




SUB 


NDELX 








0262 




STO 


NX 








0263 




STO 


NX1 








0264 




AXT 


3,1 








0265 


A3 


CLA 


*»,1 








0266 




STO 


NY , 1 








0267 




TIX 


A3, 1,1 








0268 




CLA 


NY1 








0269 




STO 


NY 








0270 




MAIN 


LOOP 








0271 




AXT 


3,1 








0272 


L00P2 


CLA 


NY2 








0273 




SUB 


NYl 








0274 




SSP 










0275 




ADD 


NDELX 








0276 




LRS 


35 








0277 




DVP 


DOT 








0278 




XCA 










0279 




ALS 


18 








0280 




OCT 










0281 




CLA 


= 1817 








0282 




STO 


NX2 


NO* 


PLOTS BETWEEN 


EACH POINT 


0283 




CLM 










0284 




LDQ 


NDELX 








0285 




LLS 


18 








0286 




DVP 


NX2 








0287 




STO 


DELX 


SEPARATION (SCOPE 


UNITS) BETWEEN PLOTS 


0288 




LDQ 


=0 








0289 




CLA 


= 1B34 








0290 




DVP 


NX2 








0291 




STQ 


DU 








0292 




STQ 


DUi 








0293 




CLA 


NYl 








0294 




STO 


E3 








0295 




SSM 










0296 
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ADO 


NY2 


0297 


STO 


E2 


0298 


SSM 




0299 


SUB 


NY2 


0300 


ADD 


NY3 


0301 


ARS 


1 


0302 


STO 


El 


0303 


ALS 


1 


0304 


SUB 


NY2 


0305 


ADD 


NY1 


0306 


ADD 


NY1 


0307 


SUB 


NY 


0308 


LDQ 


=0 


0309 


LRS 


17 


0310 


DVP 


*6B17 


0311 


STQ 


E 


0312 


CENTRAL 


LOOP 


0313 


CLA 


NY1 


0314 


STO 


F3 


0315 


ARS 


18 


0316 


STA 


POINT 


0317 


CLA 


NX 


0318 


ADD 


NDELX 


0319 


STO 


NX 


0320 


STO 


NX1 


0321 


STD 


POINT 


0322 


AXT 


6,4 


0323 


WTV 




0324 


CPY 


POINT 


0325 


TIX 


»~2,4,1 


0326 


AXT 


3,2 


0327 


CLA 


NX2 


0328 


SUB 


= 1817 


0329 


TZE 


A9 


0330 


STO 


NX2 


0331 


CLA 


DU 


0332 


SUB 


=2B17 


0333 


XCA 




0334 


MPY 


E 


0335 


LLS 


17 


0336 


ADD 


El 


0337 


STO 


A 


0338 


CLA 


DU 


0339 


SUB 


= 1B17 


0340 


XCA 




0341 


MPY 


A 


0342 


LLS 


17 


0343 


ADD 


E2 


0344 


XCA 




0345 


MPY 


DU 


0346 


LLS 


17 


0347 


ADD 


E3 


0348 


STO 


F + 1,2 


0349 


ARS 


18 


0350 


STA 


POINT 


0351 


CLA 


NX1 


0352 


ADD 


DELX 


0353 


STO 


NX1 


0354 


STD 


POINT 


0355 


WTV 




0356 


CPY 


POINT 


0357 


CLA 


DU 


0358 


ADD 


DU1 


0359 


STO 


DU 


0360 


TIX 


A5,2,l 


0361 


CLA 


F 


0362 


STO 


E3 


0363 


SUB 


Fl 


0364 


STO 


E2 


0365 


SUB 


Fl 


0366 


ADD 


F2 


0367 


STO 


El 


0368 


SUB 


Fl 


0369 


ADD 


F2 


0370 


ADD 


F2 


0371 
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SUB 


F3 


0372 




STO 


E 


0373 




CLA 


NX2 


0374 




POX 


a 


0375 




SUB 


= 1B17 


0376 




TZE 


A9 


0377 


A6 


CLA 


E 


0378 




ADD 


El 


0379 




STO 


El 


0380 




ADD 


E2 


0381 




STO 


E2 


0382 




ADD 


E3 


0383 




STO 


E3 


0384 




PDX 


»4 


0385 




SXA 


POINT, 4 


0386 




CLA 


NX1 


0387 




ADD 


DELX 


0388 




STO 


NX1 


0389 




STD 


POINT 


0390 




WTV 




0391 




CPY 


POINT 


0392 




TIX 


A6 1 2 v I 


0393 


A9 


CLA 


NYl 


0394 




STO 


NY 


0395 




CLA 


NY2 


0396 




STO 


NYl 


0397 




CLA 


NY3 


0398 




STO 


NY2 


0399 


NYADO 


CLA 


I 


0400 




STO 


NY3 


0401 


A10 


TXI 


•♦It 1,1 


0402 




TXL 


L00P2.1,** M 


0403 




CLA 


NY2 


0404 




STO 


NY3 


0405 


All 


TXL 


L00P2,1,*» M+l 


0406 




LXD 


HSTPLT-2,4 


0407 


AOR 


AXT 


*»,1 


0408 




AXT 


»*,2 


0409 




TRA 


9,4 


0410 


NDELX 


PZE 




0411 


NDELX1 


PZE 




0412 


DELX 


PZE 




0413 


NX 


PZE 




0414 


NX1 


PZE 




0415 


NX2 


PZE 




0416 


DOT 


PZE 




0417 


A 


PZE 




0418 


POINT 


PZE 




0419 


F3 


PZE 




0420 


F2 


PZE 




0421 


Fl 


PZE 




0422 


F 


PZE 




0423 


E3 


PZE 




0424 


E2 


PZE 




0425 


El 


PZE 




0426 


E 


PZE 




0427 


DU 


PZE 




0428 


DUl 


PZE 




0429 


NY3 


PZE 




0430 


NY2 


PZE 




0431 


NYl 


PZE 




0432 


NY 


PZE 




0433 




PZE 




0434 




PZE 




0435 


I ORG 


PZE 




0436 




END 




0437 
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* HSTPLT-I II (7090) (SUBROUTINE) 9/8/64 LAST CARD IN DECK IS NO* 0445 

* FAP 0001 

* HSTPLT-I 1 1 (7090) 0002 

COUNT 450 0003 

LBL HSTPLT III 0004 

ENTRY HSTPLT ( LNY, NY, ORG, NDELX, DOT, AX I S, IFRSTB, ISKIPB ) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - HSTPLT-I 1 1 (7090) 0009 

* CUBIC CURVE SCOPE PLOTTING FOR SUBROUTINE GRAPH 0010 

* 0011 

* HSTPLT PLOTS THE INPUT DATA AS DARKENED POINTS WITH CUBIC 0012 

* CURVES FITTED BETWEEN THE POINTS* EXCEPT AT THE ENDS OF 0013 

* THE DATA, THE NEAREST FOUR DATA POINTS ARE USED FOR 0014 

* DETERMINING THE CUBIC. AT THE END OF THE DATA SEQUENCE 0015 

* THE NEXT POINT IS ASSUMED TO BE THE SAME AS THE FINAL 0016 

* POINT. IF DESIRED, AN X-AXIS WITH SHORT BARS SPACED AT 0017 

* REGULAR INTERVALS IS PLOTTED. THE BEGINNING POINT AND THE 0018 

* SPACING OF THE BARS ARE CONTROLLED BY INPUT ARGUMENTS. 0019 
« 0020 

* LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0021 
» EQUIPMENT - 7090 (MAIN FRAME AND SCOPE) 0022 

* STORAGE - 258 REGISTERS 0023 

* SPEED - FAST (OPTIMUM) 0024 

* AUTHOR - R.A. WIGGINS, 9/5/62 0025 

* 0026 

* USAGE 0027 

* 0028 

* TRANSFER VECTOR CONTAINS ROUTINES - LINEH 0029 

* AND FORTRAN SYSTEM ROUTINES - NONE 0030 
» 0031 

* FORTRAN USAGE 0032 

* CALL HSTPLT ( LNY , NY,ORG, NDELX , DOT , AX I S, IFRSTB, ISKIPB1 0033 

* 0034 

* INPUTS 0035 

* 0036 

* NY(I) 1=1. ..LNY ARE FORTRAN II INTEGER DATA POINTS SCALED FOR 0037 

* SCOPE PRESENTATION. 0038 

* MUST BE GRTHN=0, LSTHN 1024 0039 

* 0040 

* LNY IS FORTRAN II INTEGER 0041 

* SHOULD BE LSTHN 200 FOR GOOD RESOLUTION 0042 
» 0043 

* ORG(I) 1=1.. .3 ARE FLOATING POINT NUMBERS GIVING THE X,Y 0044 

* COORDINATES OF THE AXIS AND THE X COORDINATES OF THE 0045 

* PLOTTED NY SERIES, ALL IN SCOPE UNITS 0046 
» ORG ( 1 ) -LEFT X COORDINATE 0047 

* 0RG(2)=Y COORDINATE FOR AXIS 0048 
» 0RG(3)=RIGHT X COORDINATE 0049 

* 0.0 LSTHN= ORG(I) LSTHN- 1023.0 0050 

* 0051 

* NDELX THE SPACING, IN SCOPE UNITS, BETWEEN SUCCESSIVE DATA 0052 

* POINTS MULTIPLIED BY (2**7) 0053 

* IS FORTRAN II INTEGER 0054 

* 0055 

* DOT =0. SOLID LINES PLOTTED 0056 

* NOT=0. DOTTED LINES PLOTTED 0057 

* 0058 

* AXIS =0. AXIS AND CROSSBARS ARE PLOTTED 0059 

* NOT=0. NO AXIS IS PLOTTED 0060 

* 0061 

* IFRSTB IS THE INDEX OF THE FIRST DATA POINT FOR WHICH A 0062 

* CROSSBAR IS PLOTTED ON THE AXIS 0063 

* IS FORTRAN II INTEGER 0064 

* 0065 

* ISKIPB IS THE NUMBER OF INDICES WHICH ARE SKIPPED BETWEEN THE 0066 

* PLOTTED CROSSBARS 0067 

* IS FORTRAN II INTEGER 0068 

* 0069 

* OUTPUTS DATA PLOTTED ON SCOPE 0070 

* 0071 

* EXAMPLES 0072 

* 1. INPUTS - NY(1...10)=100,100,100,100,100,100,100,100,100,100 0073 

* LNY=10 ORG( 1...3)=10.,20., 1010. NDELX-14222 0074 
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* 2. INPUTS 



DOT=0. AXIS=0* IFRSTB*3 ISKIPB=2 
SAME AS EXAMPLE 1. EXCEPT 

NY( l.«*10) = 100,180,260,340,420,500,580,660t740,820 
IFRSTB=1 ISKIPB=1 



OUTPUTS - FOR EXAMPLES 1 AND 2. 




* 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT 

* NY( 1... 10) =100, 108, 132 f 172 » 228, 300,388,484,612* 748 

* D0T=1. AXIS=1. 
* 

* 4. INPUTS - SAME AS EXAMPLE I. EXCEPT 

* NY ( 1... 10) =100, 101,108, 127, 164,225,316,443*612,829 
» AXIS=1. 

» 

* OUTPUTS - FOR EXAMPLES 3 ANO 4. 




* 5. INPUTS 



SAME AS EXAMPLE 1. EXCEPT 

NY(1»»*10)=100, 200 ,200 ,300, 300, 500, 50t 60,1000, 10 AXIS*1* 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
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• 6. INPUTS - NY(1..«100)=500, 500, 500, 500,500, 500,500,500 
» 500,450,400, 350, 300, 250, 200, 150 

♦ 0, 10, 40, 90,160,250,360,490 
» 1000,999,992,973,936,875,784,657, 

* 0, 6, 25, 57, 95,146,206,273 

• 500,579,655,727,794,854,905,943 

• 1000,024,042,119,092,482,054,272 
» 865,667,432,112,346,178,931,625 

* 301,755,427,874,444,977,383,988 

* 290,402,491,269,463,885,423,639 
» LNY=100 ORG( i..3)=10.,20.,1010. NDELX=1293 
» DOT=0. AXIS=1. 
* 

» OUTPUTS - FOR EXAMPLES 5 AND 6. 



500,500, 
100, 50, 
640,810, 
488,271, 
345,421, 
975,994, 
048,325, 
517,627, 
218,512, 
798,363 




BSS 0 

FOLLOWING CARD DESIGNATES THE DATA CHANNEL THAT CRT IS ATTACHED TO. 
TO CHANGE, ALTER THE LETTER DESIGNATION ONLY AND REASSEMBLE. 



0148 
0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 



X 


TAPENO 


Dl 


0192 


SCPAD 


EOU 


X-105 


0193 




PZE 




0194 




BCI 


itHsfin 


0195 


HSTPLT 


SXD 


—2,4 


0196 




SXA 


ADR, I 


0197 




SXA 


ADR+1,2 


0198 




CAL 


3,4 


0199 




ADD 


= 1B35 


0200 




STA 


ORG 


0201 


* 


FIX ORGU-4) 


0202 




AXT 


3,1 


0203 


ORG 


CLA 


*»a 


0204 




UFA 


=0233000000000 


0205 




ANA 


=0377777 


0206 




ALS 


18 


0207 




STO 


IORG+1,1 


0208 




TIX 


ORG, it 1 


0209 




CLA« 


4,4 


0210 




ARS 


7 


0211 




STO 


NDELX 


0212 


• 


DO HORIZONTAL AXIS IF AXIS=0 


0213 




CLA» 


6,4 


0214 




TNZ 


A2 


0215 




TSX 


SLINEH,4 


0216 




TSX 


IORG,0 


0217 




TSX 


IORG-1,0 


0218 




TSX 


IORG-2,0 


0219 




TSX 


=4817,0 


0220 




LXD 


HSTPLT-2,4 


0221 




LDO 


NDELX 


0222 
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MPY* 


7,4 










0223 




LLS 


17 










0224 




ADO 


I ORG 










0225 




STO 


NX 










0226 




STD 


NXi 










0227 




LDQ 


NDELX 










0228 




mpy» 


8,4 










0229 




LLS 


17 










0230 




STO 


NDELX1 










0231 




CLA» 


1,4 










0232 




PDX 


♦ 2 










0233 




CLA 


IORG-l 










0234 




AOO 


=12817 










0235 




STO 


L00P1+4 










0236 




CLA* 


8,4 










0237 




STD 


Al 










0238 




LXD 


IORG-1,1 










0239 




SXA 


NX1,1 










0240 


L00P1 


WRS 


SCPAD 










0241 




RCHX 


101 










0242 




TXI 


♦♦1,1,4 










0243 




SXA 


NX 1,1 










0244 




TXL 


L00P1,1,»* 










0245 




CLA 


NX 










0246 




ADD 


NDELX 1 










0247 




STO 


NX 










0248 




STD 


NXI 










0249 


Al 


TIX 


LOOPl-2,2,** 










0250 




SET UP CONSTANTS FOR 


MAIN 


LOOP 






0251 


A2 


CLA* 


5,4 










0252 




TNZ 


*+4 










0253 




CLA 


=4B17 










0254 




STO 


DOT 










0255 




TRA 


*+3 










0256 




CLA 


=8B17 










0257 




STO 


DOT 










0258 




CAL 


2,4 










0259 




STA 


NYADD 










0260 




ADD 


= 1B35 










0261 




STA 


A3 










0262 




CLA* 


1,4 










0263 




STD 


A10 + 1 










0264 




ADD 


= 1817 










0265 




STD 


All 










0266 




CLA 


IORG 










0267 




SUB 


NDELX 










0268 




STO 


NX 










0269 




STO 


NXI 










0270 




AXT 


3,1 










0271 


A3 


CLA 


**,1 










0272 




STO 


NY, 1 










0273 




TIX 


A3, 1,1 










0274 




CLA 


NY1 










0275 




STO 


NY 










0276 




MAI N 


LOOP 










0277 




AXT 


3,1 










0278 


L00P2 


CLA 


NY2 










0279 




SUB 


NY1 










0280 




SSP 












0281 




ADD 


NDELX 










0282 




LRS 


35 










0283 




DVP 


DOT 










0284 




XCA 












0285 




ALS 


18 










0286 




DCT 












0287 




CLA 


= 1B17 










0288 




STO 


NX2 


NO. 


PLOTS 


BETWEEN 


EACH POINT 


0289 




CLM 












0290 




LDO 


NDELX 










0291 




LLS 


18 










0292 




DVP 


NX2 










0293 




STO 


DELX 


SEPARATION 


(SCOPE 


UNITS) BETWEEN PLOTS 


0294 




LDQ 


=0 










0295 




CLA 


= 1834 










0296 




DVP 


NX2 










0297 
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STQ 


DU 


0298 


STO 


DU1 


0299 


CLA 


NY1 


0300 


STO 


E3 


0301 


SSM 




0302 


ADD 


NY 2 


0303 


STO 


E2 


0304 


SSM 




0305 


SUB 


NY2 


0306 


ADD 


NY3 


0307 


ARS 


1 


0308 


STO 


El 


0309 


ALS 


1 


0310 


SUB 


NY2 


0311 


ADD 


NY1 


0312 


ADD 


NY1 


0313 


SUB 


NY 


0314 


LDQ 


=0 


0315 


IRS 


17 


0316 


DVP 


=6817 


0317 


STQ 


E 


0318 


CENTRAL 


LOOP 


0319 


CLA 


NY1 


0320 


STO 


F3 


0321 


ARS 


18 


0322 


STA 


POINT 


0323 


CLA 


NX 


0324 


ADD 


NDELX 


0325 


STO 


NX 


0326 


STO 


NX1 


0327 


STD 


POINT 


0328 


AXT 


6,4 


0329 


MRS 


SCPAD 


0330 


RCHX 


102 


0331 


TIX 


*-2,4,l 


0332 


AXT 


3,2 


0333 


CLA 


NX2 


0334 


SUB 


= 1B17 


0335 


TIE 


A9 


0336 


STO 


NX2 


0337 


CLA 


DU 


0338 


SUB 


=2B17 


0339 


XCA 




0340 


MPY 


E 


0341 


LLS 


17 


0342 


ADD 


El 


0343 


STO 


A 


0344 


CLA 


DU 


0345 


SUB 


= 1817 


0346 


XCA 




0347 


MPY 


A 


0348 


LLS 


17 


0349 


ADD 


E2 


0350 


XCA 




0351 


MPY 


DU 


0352 


LLS 


17 


0353 


ADD 


E3 


0354 


STO 


F+1,2 


0355 


ARS 


18 


0356 


STA 


POINT 


0357 


CLA 


NX1 


0358 


ADD 


DELX 


0359 


STO 


NX1 


0360 


STD 


POINT 


0361 


WRS 


SCPAD 


0362 


RCHX 


102 


0363 


CLA 


DU 


0364 


ADD 


DU1 


0365 


STO 


DU 


0366 


TIX 


A5,2,l 


0367 


CLA 


F 


0368 


STO 


E3 


0369 


SUB 


Fl 


0370 


STO 


E2 


0371 


SUB 


Fl 


0372 
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ADD 


F2 


0373 




STO 


El 


0374 




SUB 


Fl 


0375 




ADD 


F2 


0376 




ADD 


F2 


0377 




SUB 


F3 


0378 




STO 


E 


0379 




CLA 


NX2 


0380 




PDX 


♦ 2 


0381 




SUB 


= 1 B 17 


0382 




TZE 


A9 


0383 


A6 


CLA 


E 


0384 




ADD 


El 


0385 




STO 


El 


0386 




ADD 


E2 


0387 




c Tn 
S 1 0 


E2 


0388 




ADD 


E3 


0389 




STO 


E3 


0390 




PDX 


»4 


0391 




SXA 


POI NT»4 


0392 




CLA 


NX 1 


0393 




ADD 


DELX 


0394 




c Tn 
3 1 U 


NX 1 


0395 




c Tn 
o I U 


PO I NT 


0396 




WRS 


SCPAD 


0397 




RCHX 


1 02 


0398 




TIX 


A6»2» I 


0399 


A9 


CLA 


NY1 


0400 




STO 


NY 


0401 




CLA 


NY2 


0402 




STO 


NY 1 


0403 




CLA 


NY3 


0404 




STO 


NY2 


0405 


NYADO 


CLA 


**» I 


0406 




STO 


NY 3 


0407 


A10 


TXI 


»♦ I » I * 1 


0408 




TXL 


L00P2»1»*» M 


0409 




CLA 


NY2 


0410 




S TO 


NY 3 


041 1 


All 


TXL 


L00P2fl»** M+l 


0412 




LXD 


HSTPLT— 2»4 


0413 


ADR 


AXT 


** y I 


0414 




AXT 


♦ 2 


0415 




TR A 


9 t 4 


0416 


1 01 


I OCD 


NX 1 v 9 1 


041 7 


1 02 


I OC D 


PO I NT t v I 


041 8 


NDELX 


PZE 




0419 


NOEL XI 


PZE 




0420 


DELX 


PZE 




042 1 


NX 


PZE 




0422 


NX1 


D 7 C 




0423 


llAt 


PZE 




0424 


UU 1 


Kit 




0425 


A 

A 


D 7 C 

r Liz 




0426 


PO I NT 


PZE 




0427 


F3 


PZE 




0428 


F2 


PZE 




0429 


Fl 


PZE 




0430 


F 


PZE 




0431 


E3 


PZE 




0432 


E2 


PZE 




0433 


E 1 


PZE 




0434 


c 
c 






0435 


OU 


PZE 




0436 


DU1 


PZE 




0437 


NY3 


PZE 




0438 


NY2 


PZE 




0439 


NY1 


PZE 




0440 


NY 


PZE 




0441 




PZE 




0442 




PZE 




0443 


I ORG 


PZE 




0444 




END 




0445 
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• 


HVTOIV 


(SUBROUTINE) 9/29/64 LAST CARD IN 


DECK IS NO. 


0109 


• 


FAP 






0001 


•HVTOIV 






0002 




COUNT 


100 




0003 




LBL 


HVTOIV 




0004 




ENTRY 


HVTOIV (HV,LHV,IV) 




0005 


* 








0006 


* 




ABSTRACT 




0007 


• 








0008 


« 


TITLE - HVTOIV 




0009 


• 


SPREAD OUT HOLLERITH VECTOR AS FORTRAN INTEGERS 




0010 


* 








0011 


• 




HVTOIV SPREADS OUT A VECTOR HV(I), 1=1. ..LHV, AS 


A 


0012 


• 




FORTRAN INTEGER VECTOR IV(I), I=1...6«LHV. EACH 


REGISTER 


0013 


• 




OF HVtl) IS ASSUMED TO BE IN F0RMATCA6) AND IS SPREAD 


0014 


* 




OUT AS 6 INTEGERS. THE INTEGER VALUES WILL LIE 


IN THE 


0015 


• 




RANGE +0 TO +63. 




0016 


* 








0017 


• 




HVTOIV IS THE INVERSE OF SUBROUTINE IVTOHV 




0018 


* 








0019 


• 


LANGUAGE - 


FAP SUBROUTINE (FORTRAN II COMPATIBLE) 




0020 


• 


EQUIPMENT - 


709 OR 7090 (MAIN FRAME ONLU) 




0021 


• 


STORAGE 


39 REGISTERS 




0022 


* 


SPEED 


84*LHV MACHINE CYCLES 




0023 


• 


AUTHOR 


S.M. SIMPSON, MARCH 1963 




0024 


• 








0025 


» 




—USAGE 




0026 


• 








0027 


• 


TRANSFER VECTOR CONTAINS ROUTINES - NONE 




0028 


• 


AND FORTRAN SYSTEM ROUTINES - NONE 




0029 


* 








0030 


• 


FORTRAN USAGE 




0031 


• 


CALL HVTOIV(HV,LHV,IV) 




0032 


• 








0033 


• 


INPUTS 






0034 


* 








0035 


m 


HV(I ) 


1*1. ..LHV IS HOLLERITH VECTOR IN A6 FORMAT 




0036 


* 








0037 


• 


LHV 


MUST EXCEED 0 (STRAIGHT EXIT FOR ILLEGAL LHV) 




0038 


• 








0039 


* 


OUTPUTS 






0040 


* 








0041 


• 


ivm 


I=1...6*LHV IS THE INTEGER VECTOR EQUIVALENT TO HVU5 


0042 


• 








0043 


» 


EXAMPLES 






0044 


* 








0045 


• 


1. INPUTS - 


- HV(l) = 6HCHARAC ( = 0CT233021512123 ) 




0046 


* 




HV(2) * 6HTERS T (= 0CT63255 1 526063 ) 




0047 


» 




HV(3) * 6H0 SPRE ( = 0CT466062475125 ) 




0048 


* 




HV(4) * 6HAD OUT 0CT212460466463 ) 




0049 


• 




HV(5) * 5HIN IV (= OCT314560315460) 




0050 


* 








0051 




USAGE - DIMENSION HV ( 5 ) , I V 1 ( 30 ) , I V2( 6) , I V3 ( 6 ) 




0052 


* 




CALL HVT0IV(HV,5, IV1) 




0053 


• 




CALL HVT0IV(HV(5),l,IV2) 




0054 


» 




CALL HVTOIV(HV,0, IV3) 




0055 


» 


OUTPUTS - 


- IVK1...30) * 19,24,17,41,17,19,51,21,41,50, 




0056 


• 




48,51,38,48,50,39,41,21,17,20, 




0057 


• 




48, 38 , 52, 51, 25 , 37, 48, 25, 53, 48 




0058 


* 




IV2U...6) » 25,37,48,25,53,48 




0059 


• 




IV3U) IS NOT CHANGED (ILLEGAL LHV) 




0060 


• 








0061 


* 


PROGRAM FOLLOWS BELOW 




0062 




HTR 


0 




0063 




HTR 


0 




0064 




HTR 


0 




0065 




BCI 


1, HVTOIV 




0066 


HVTOIV SXD 


HVTOIV-2,4 




0067 




SXD 


HVTOIV-3,2 




006 8 




SXD 


HVTOIV-4,1 




0069 




SETUP SEQUENCE 




0070 




CLA 


1,4 A(HV) 




0071 




ADD 


Kl 




0072 




STA 


GET 




0073 




CLA* 


2,4 LHV 




0074 
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TMI 
TZE 
STD 
CLA 
ADO 
STA 
CLA 
STD 



LEAVE 

LEAVE 

TESTLH 

3,4 

Kl 

STO 

KD6 

TEST6 



A( IV) 



<XR1 CONTROLS ACQUISITION, XR2 CONTROLS STORAGE) 
AXT 1,1 
AXT 1,2 
NEXT HOLLERITH 

LDQ *»,1 **=A(HVm 

T AND STORE LOOP 



♦ GET 
GET 

* SHIP 
SHIFT 



STO 



TEST6 
♦ BUMP 



CLA 
LGL 
ALS 
STO 
TXI 
TXL 



KDO 
6 
18 

»»,2 
*+i,2,l 
SHIFT, 2,** 



•»=AI IV) + 1 



••=6, 12, 



DECREMENT OF TESTL AND INDEX 1. TEST FINISH 



TESTLH 
* EXIT 
LEAVE 



» CONS 
KDO 
KD6 
Kl 



CAL 
ACL 
SLW 
TXI 
TXL 

LXD 
LXD 
TRA 
TANTS 
PZE 
PZE 
PZE 
END 



TEST6 

KD6 

TEST6 

•♦1,1,1 

GET,1,»* 

HVTOIV-3,2 
HVTOIV-4, 1 
4,4 

0 

0,0,6 
I 



**=LHV 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
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IDERIV (SUBROUTINE) 
FAP 



9/29/64 



LAST CARD IN DECK IS NO, 



► I DERI V 



COUNT 150 
LBL IDERIV 

ENTRY IDERIV ( YOFXl , DYDX , DELX, LY , YOFX ) 

» 

* ABSTRACT 

» 

» TITLE - IDERIV 

* INVERSION OF DIFFERENTIATION BY DIFFERENCING 
* 

* IDERIV PERFORMS THE INVERSE OPERATION TO THAT OF 

* SUBROUTINE DERIVA, I.E. IT FINDS A VECTOR, YOFX, 

* WHOSE DERIVATIVE BY DIFFERENCING IS A GIVEN VECTOR, 

* DYDX. THE INITIAL VALUE OF YOFX IS REQUIRED AS INPUT. 
• 

* THE OUTPUT VECTOR YOFX MAY REPLACE THE INPUT VECTOR. 
• 

* LANGUAGE - FAP SUBROUTINE (FORTRAN— 1 1 COMPATIBLE) 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 

* STORAGE - 54 REGISTERS 

* SPEED - 7090 709 7090 

* (66.0 OR 70.6) ♦ (25.4 OR 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 
• 

* USAGE 



709 
28.6)»LY 



MACHINE CYCLES 



» TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 
• AND FORTRAN SYSTEM ROUTINES - (NONE) 

» FORTRAN USAGE 

» CALL IDERIV( YOFXl, DYDX, DELX, LY, YOFX) 



INPUTS 
YOFXl 
DYDX(I) 
DELX 
LY 

OUTPUTS 
YOFX ( I ) 



NOTE THAT THE ARGUMENTS ARE IDENTICAL TO THOSE OF 
SUBROUTINE DERIVA EXCEPT THAT THE ORDER IS REVERSED. 
SEE SUBROUTINE DERIVA FOR DETAILED DISCUSSION. 



IS STARTING VALUE FOR YOFX(l) 

1=1. ..LY IS THE DERIVATIVE AS PRODUCED BY DERIVA 
WAS THE ( NON-ZERO) DELTA X USED IN OBTAINING DYDX 
MUST EXCEED 1 

STRAIGHT RETURN WITH NO ACTION IF LY LSTHN 2 OR DELX *0. 

1=1.. .LY IS THE INTEGRATED FORM OF DYDX, WHERE 
YOFX(l) * YOFXl 

Y0FX(2) = DELX*DYDX ( 1 ) ♦ YOFX(l) 
YOFX(K) « 2*0ELX»DYDX(K-1) + Y0FX(K-2) 
FOR K » 3,4, • • • , LY 

EQUIVALENCE ( YOFX, DYDX ) IS PERMITTED. 



* 


EXAMPLES 


THESE EXAMPLES ARE 


THE 


INVERSES 


OF 


THE 


» 




FOR DERIVA. 










• 
» 


I. INPUTS 


- Dl(l..*5) * 4., 6 


6 


., 2., 0. 






* 




02(1. .«5) » -2. ,-3 


• t-3 


.,-1., 0. 






* 




D3U...2) = 4., 4 














Y4 = Y5 = -999. 










» 


USAGE 


CALL IDERIV( 


2., 


Dl, 1., 


5, 


YD 


• 




CALL IDERIV( 


2., 


D2, -2., 


5, 


Y2) 


» 




CALL IDERIV( 


2., 


D3, 1., 


2, 


Y3) 


• 




CALL IDERIV( 


2., 


Dl, I., 


1. 


Y4) 


* 




CALL IDERIV( 


2., 


Dl, 0., 


5, 


Y5) 


• 


OUTPUTS 


- YK1...5) = Y2(l.. 


.5) 


* 2«, 6. 


, 1 


4., 



Y3( 1. 



.2) = 



6. 



18., 18. 

Y4=Y5 = -999. (NO OUTPUT CASES) 



2. MULTIPLE INTEGRATION WITH OUTPUTS REPLACING INPUTS 
INPUTS - DYU...6) » 2., 0., -3., 0., 4., 4. 



0148 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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« FY(1..*3> = 0., 4., 4. (NOTE REVERSAL OF ORDER FROM 0075 

* THAT IN EXAMPLE OF OERIVAI 0076 

* USAGE - DO 10 1=1,3 0077 
« 10 CALL I DERI V ( FY( I ) , DY, l.t 6, DY ) 0078 

* OUTPUTS - DYU...6) = 4., 8., 12., 24., 20., 24. 0079 

* 0080 
» PROGRAMS FOLLOWS BELOW 0081 
» 0082 

* 0083 
» NO TRANSFER VECTOR 0084 

HTR 0 XR4 0085 

BCI 1, IOERIV 0086 

» ONLY ENTRY. IDERIV< Y0FX1 , DYDX, DELX , LY, YOFX) 0087 

IDERIV SXO IDERIV-2,4 0088 

* CHECK LY (GRTHN=2) AND DELX (NON-ZERO) 0089 

CLA* 4,4 LY 0090 

TMI LEAVE 0091 

PDX 0,4 0092 

TXL LEAVE, 4,1 0093 

SXD TXL, 4 0094 

LXD IDERIV-2,4 0095 

CLA« 3,4 DELX 0096 

TZE LEAVE 0097 

* OK, SETUP 0098 

XCA 0099 

FMP FL2 0100 

STO TWODX 2*DELX 0101 

CLA 2,4 A(DYDX) 0102 

SUB Kl A(DYDX)-1 0103 

STA GET2 0104 

ADD K2 AlDYDXm 0105 

STA GET 0106 

CLA 5,4 0107 

SUB Kl A(Y0FX)-1 0108 

STA ST02 0109 

ADD K2 A(Y0FX)+1 0110 

STA STORE 0111 

ADD K2 A(Y0FX)+3 0112 

STA FAD 0113 

» FORM AND SET Y0FX(1*..2) 0114 

LDQ* 2,4 DYDX(l) 0115 

FMP TWODX 0116 

FDP FL2 DELX*DYDX(1) 0117 

STQ OLDDY SET ASIDE. 0118 

CLA* 1,4 YOFXi 0119 

ST0» 5,4 IS YOFX(l). 0120 

FAD OLDDY PLUS DELX»0YDX ( 1 ) 0121 

GET2 LDQ *» «*=A(DYDX)-1 0122 

ST02 STO ** *»=A(Y0FX)-1 IT BECOMES Y0FXI2). 0123 

STQ OLDDY SAVE DYDX(2) FOR LOOP 0124 

» EXIT IF LY*2 0125 

LXD TXL, 4 0126 

TXL LEAVE, 4, 2 0127 

» OTHERWISE PROCEED TO LOOP 0128 

AXT 3,4 0129 

* LOOP TO SET Y0FX(3,4,...K,...LY) K IN XR4 0130 
GET CLA **,4 ♦*=A(DY0FX)+1 DYOFX(K) 0131 

LDQ OLDDY 0132 

STO OLDDY SET ASIDE. 0133 

FMP TWODX 2*DELX*DY0FX(K-1) 0134 

FAD FAD **,4 »*=A(Y0FX>+3 PLUS YOFXU-2) 0135 

STORE STO **,4 *»= ( YOFX ) +1 IS YOFX(K). 0136 

TXI *+l,4,l 0137 

TXL TXL GET, 4,** »»*LY 0138 

* EXIT 0139 
LEAVE LXD IDERIV-2,4 0140 

TRA 6,4 0141 

* CONSTANTS, TEMPORARIES 0142 
FL2 DEC 2.0 0143 
Kl PZE 1 0144 
K2 PZF 2 0145 
TWODX PZE **,#*,#* 2»DELX 0146 
OLDDY PZE »*,*«,#* DYDX(K-i) STARTS AT DYDX(23 0147 

END 0148 



»«***«***••*«**•«»•»•**» PROGRAM LISTINGS 

• IF IPSEUDO ENTRY) • 

♦*»»»*♦♦♦*♦***»»**»**#*» 

REFER TO 

SEVRAL 



* IF (PSEUDO ENTRY ) * 
*•*«*«*•**•****»•****«*» 

REFER TO 

SEVRAL 
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IFNCTN (SUBROUTINE) 
FAP 



9/4/64 



CAST CARD IN DECK IS NO* 



♦IFNCTN 



COUNT 400 
LBL IFNCTN 

ENTRY IFNCTN (YOFX, LYOFX, XFIRST, XLAST, LXOFY, YLO, YHI* 
IERRLOt XOFY, IANS) 



» ABSTRACT 

• 

» TITLE - IFNCTN 

* INVERSION OF A MONOTONE FUNCTION BY LINEAR INTERPOLATION 
• 

* IFNCTN TAKES A MONOTONELY INCREASING ( NON-DECREASING ) 

* OR MONOTONELY DECREASING ( NON- INCREAS ING ) SET OF 

* FUNCTION VALUES 



Y(X) FOR X » XI, Xi+DX, XI+2DX, 



.., X2=Xi+tLY-l)DX 



* LANGUAGE 

• EQUIPMENT 

• STORAGE 

♦ SPEED 



AUTHOR 



AND PROOUCES, BY LINEAR INTERPOLATION, A SET OF FUNCTION 
VALUES 

X(Y) FOR Y = YLOt YLO+DY, YHI*YLO+< LX- I ) DY 

WHERE THE PROGRAM INPUTS ARE Y C X ) , LY, X 1 ,X2 , LX, YLO, AND 
YHI. IF Y(X) HAS FLAT AREAS WHOSE HEIGHTS ARE IN THE 
LIST OF ARGUMENTS OF X(Y), THEN THE VALUES CHOSEN FOR 
X ARE THE MIDPOINTS OF SUCH AREAS* 



- FAP SUBROUTINE ( FORTRAN-I I COMPATIBLE) 

- 709,7090,7094 (MAIN FRAME ONLY) 

- 208 REGISTERS 

- IF Y(X) IS MONOTONE INCREASING, IFNCTN TAKES ABOUT 

280 ♦ 25 LY + 70 LX MACHINE CYCLES ON THE 7090, 
AND IF Y(X) IS MONOTONE DECREASING, 

410 ♦ 37 LY + 70 LX MACHINE CYCLES 
WITH LY AND LX AS DEFINED IN ABSTRACT. 

- S.M. SIMPSON, JUNE 1964 



» USAGE 

» 

» TRANSFER VECTOR CONTAINS ROUTINES - MONOCK, REVER 

• AND FORTRAN SYSTEM ROUTINES - NOT ANY 

* FORTRAN USAGE 

CALL I FNCTN ( YOFX , LYOFX, XFIRST, XLAST, LXOFY, YLO, YHI, IERRLO, 



1 

INPUTS 

YOFXU) 

LYOFX 

XFIRST 

XLAST 

LXOFY 
YLO 



XOFY, IANS) 



1=1. ..LYOFX IS THE SET OF VALUES Y(X) OF THE ABSTRACT. 
MUST BE EITHER NON-DECREASING OR NON-INCREASING. 



IS THE QUANTITY 
MUST BE GRTHN- 

IS THE ARGUMENT 
YOFX(l). 

IS THE ARGUMENT 
YOFX (LYOFX). 
XLAST MUST NOT 

IS THE ARGUMENT 
MUST BE GRTHN= 



LY OF THE ABSTRACT. 
2 . 

XI OF THE ABSTRACT, I.E., Y(XFIRST) * 



X2 OF THE ABSTRACT, I.E., YIXLAST) * 

= XFIRST (BUT MAY BE LESS THAN XLAST). 

LX OF THE ABSTRACT. 
1 . 



IS GIVEN IN THE ABSTRACT. LET YMIN « M IN IMUM( YOFX< I I ) 
AND YMAX = MAX I MUM ( YOFX ( I ) ) • THEN YLO MUST SATISFY 
YMIN LSTHN= YLO LSTHN YMAX FOR LXOFY GRTHN 1, 
OR YMIN LSTHN= YLO LSTHN* YMAX FOR LXOFY « I . 
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0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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YHI 



I ERRLO 



» OUTPUTS 



IS GIVEN IN ABSTRACT, BUT IT IS NOT REFERRED TO IF 

LXOFY =5 1 . IF LXOFY GRTHN* 2, THEN YHI MUST 
SATISFY YLO LSTHN YHI LSTHN* YMAX. 



IS THE DESIRED ERROR VALUE FOR 

ILLEGAL ( NON-MONOTONE ) • 
SHOULD EXCEED ZERO. 



IANS IF YOFX IS 



YOF X ( I ) 



XOFY(I) 



IANS 



OUTPUT IS SAME AS INPUT EXCEPT THAT THE SIGN BITS OF ALL 

ZERO MAGNITUDE ELEMENTS, IF ANY, WILL BE MADE POSITIVE 

IF NOT ALREADY (RESULT OF ACTION BY SUBROUTINE 
MONOCK). 



1=1.. .LXOFY IS THE INVERSE FUNCTION, 
IANS = 0 . 



COMPUTED ONLY IF 



0 

IERRLO 

IERRLO+1 

IERRLO+3 

IERRL0+4 

IERRL0+5 

IERRLO+6 



IF ALL OK 

IF YOFX ILLEGAL 



IF L YOFX 

IF XLAST 

IF LXOFY 

IF YLO 

IF YHI 



ILLEGAL 
ILLEGAL 
ILLEGAL 
ILLEGAL 
ILLEGAL 



• EXAMPLES 



»,4.,4.,4.,4.,5.,6. 

LX0FY*5 YLO=1.5 



LY0FX«9 
YHI*5*5 



MONOTONE INCREASING CASE 
INPUTS - Y0FX11...9) = l.,2.,3 

XFIRST*1.0 XLAST=9.0 

IERRL0=1 

USAGE - CALL IFNCTN( YOFX, LYOFX, XFIRST, XLAST, LXOFYI 

I YLO, YHI, IERRLO, XOFY, IANS) 

OUTPUTS - X0FYU...5) = 1 • 5, 2. 5, 3. 5, 7. 5, 8. 5 IANS=0 



MONOTONE DECREASING CASE 
INPUTS - SAME AS EXAMPLE 1. 

Y0FXU...9) * 6. ,5 
USAGE - SAME AS EXAMPLE 1. 

OUTPUTS - X0FYC1...5) * 8.5,7.5,6.5,2.5,1.5 



EXCEPT 
,4.,4.,4.,4.,3.,2« 



IANS*0 



» 3. 



NEGATIVE DELTA X CASE 

* INPUTS - SAME AS EXAMPLE 1. EXCEPT XFIRST = 9.0 XLAST = 1.0 
» USAGE - SAME AS EXAMPLE 1. 

* OUTPUTS - X0FY(l...5) * 8.5,7.5,6.5,2.5,1.5 IANS * 0 
* 

* 4. MONOTONE DECREASING AND NEGATIVE DELTA X CASE 

» INPUTS - SAME AS EXAMPLE 1. BUT WITH THE EXCEPTIONS OF BOTH 

* EXAMPLES 2. AND 3. 
» USAGE - SAME AS EXAMPLE I. 
« OUTPUTS - SAME AS EXAMPLE 1. 
» 

* 5. SPECIAL CASES WITH LXOFY =* 1,2,3 INVOLVING A FLAT AREA 

» INPUTS - SAME AS EXAMPLE 1. EXCEPT YL0=2.Q YHI=6.0 AND THE 

* OUTPUT XOFY IS AN ARRAY WITH DIMENSION X0FVI3$3I ALL 
» OF WHOSE ELEMENTS ARE INITIALLY SET = -99. 

DO 10 LXY=1,3 
10 CALL IFNCTNt YOFX , LYOFX, XFIRST, XLAST, LXY, YLO, 



USAGE 



1 YHI, IERRLO, XOFYU,LXY), IANSILXY1I 

OUTPUTS - X0FY(1...3,1) = 2. 0,-99. ,-99. 

XOFY( I. ..3, 2) = 2.0,9.0,-99. 

XOFYC 1...3,3) = 2.0,5.5,9. 

IANSU...3) = 0,0,0 



6. SPECIAL CASE WITH LYOFX 
INPUTS - SAME AS EXAMPLE 



= 2 



EXCEPT LY0FX=2 YLO=1.0 YHI*2.0 



USAGE - SAME AS EXAMPLE 1. 



OUTPUTS 



X0FYU...5) = 1.0,3.0,5.0,7.0,9.0 IANS=0 



ILLEGAL CASES 

INPUTS - Y0FX2(i...3) = 0.,20.,10. 



YOFX SAME AS EXAMPLE 1, 



USAGES 



CALL IFNCTN(Y0FX2,3,1.,2.,2,1.,2., I, XOFY, I ANSI 3 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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CALL IFNCTN(YOFX,l,l.,2.,2,i.,2.,l,XOFY, IANS29 
CALL IFNCTN( YOFX,2, l.« 1., 2, 1. , 2. , l,XOFY, 1ANS4) 
CALL IFNCTN( Y0FX,2, 1. , 2. ,0, 1. ,2. , 1,X0FY, 1ANS51 
CALL IFNCTN(YOFX, 2, 1 . , 2. , 2, 0. , 2. , 1, XOFY, IANS6) 
CALL I FNCTN( YOFX, 2, l«, 2., 2, I. t 20. , I, XOFY, IANS7A) 
CALL IFNCTN (YOFX, 2, I. ,2., 2, 1. , 1. , 1, XOFY, IANS7B ) 
OUTPUTS - IANSl,2,4, 5,6,7A, 7B, » 1,2,4,5,6,7,7 



* PROGRAM FOLLOWS BELOW 
• 

* TRANSFER VECTOR CONTAINS MONOCKCX, LX, ZFINCR, IANSNG, IANS1 

* AND REVER( X, LX, XREVD) 



HTR 
HTR 
HTR 
BCI 

* 

» ONLY ENTRY. 



0 
0 
0 

1, IFNCTN 



XRi 
XR2 
XR4 



IFNCTN SXD 
SXD 
SXD 

* 

« SET ADDRESSES 



IFNCTN ( YOFX, LYOFX, XFIRST, XLAST, LXOFY, YLO, YHI, 
IERRLO, XOFY, IANS) 

IFNCTN-4,1 
IFNCTN-3,2 
IFNCTN-2,4 



• AND DECREMENTS 



CHECK 



CLA» 


2,4 


STD 


TXH 


SUB 


KD1 


STD 


TXL1 


CLA* 


5,4 


SUB 


KD1 


STD 


TXL3 


SUB 


KD1 


STD 


TXL4 


; LYOFX 


GRTHN* 2, 


CLA* 


8,4 


ADD 


KD1 


PDX 


0,1 


CLA* 


2,4 


STO 


LYOFX 


CAS 


KD2 


NOP 




TRA 


*+2 


TRA 


LEAVE 


SUB 


KD1 


LRS 


18 


ORA 


OCTK 


FAD 


OCTK 


STO 


TEMPI 


TXI 


•4-1,1,2 


CLA* 


4,4 



LYOFX 



LYOFX-1 



LXOFY 
LXOFY- 



LXOFY-2 



XFIRST NOT- XLAST, SET DELX, XNEXT*XF IRST 
IERRLO 

IERRLO+1 TO XRI FOR ERROR FLAGGING 
LYOFX 



OK 
OK 
NG 



FLOATED LYOFX- 

IERRLO+3 

XLAST 



0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 



CLA 


1,4 


A(YOFX) 


0178 


STA 


TSXY1 




0179 


STA 


TSXR1 




0180 


STA 


TSXR3 




0181 


ADD 


Kl 


A(Y0FX}+1 


0182 


STA 


CLAY1 




0183 


STA 


CAS1 




0184 


STA 


FSB1 




0185 


STA 


CLA2 




0186 


STA 


CLA3 




0187 


ADD 


Kl 


A (YOFX) +2 


0188 


STA 


FSB2 




0189 


STA 


CAS2 




0190 


CLA 


9,4 


A(XOFY) 


0191 


ADD 


Kl 


AtXOFYJ+1 


0192 


STA 


ST01 




0193 



0194 
0195 
0196 
0197 
0198 
0199 
0200 
0201 
0202 
0203 
0204 
0205 
0206 
0207 
0208 
0209 
0210 
0211 
0212 
0213 
0214 
0215 
0216 
0217 
0218 
0219 
0220 
0221 
0222 
0223 
0224 
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STO 


XLAST 








0225 




FSB* 


3,4 


XLAST-XFIRST 






0226 




TZE 


LEAVE 


EQUALITY ERROR 






0227 




FDP 


TEMPI 








0228 




STQ 


DELX 


= (XLAST-XFIRST)/(LY0FX~1) 




0229 




CLA* 


3,4 








0230 




STO 


XNEXT 


INITIALIZE XNEXT * 


XFIRST 




0231 




CLA* 


6,4 








0232 




STO 


YNEXT 


AND YNEXT » YLO 






0233 


» 












0234 


* CHECK LXOFY 


GRTHN- 1, YLO 


LSTHN YHI IF LXOFY 


GRTHN I, FORM 


1 DELY 


0235 


• 












0236 




TXI 


*+l,l,l 


IERRLO+4 






0237 




CLA* 


5,4 


LXOFY 






0238 




STO 


LXOFY 








0239 




CAS 


KD1 








0240 




TRA 


SUB1 


OK 






0241 




TXI 


YOXCK, 1,2 


OK, BUT BYPASS CHECKS, DELY 




0242 




TRA 


LEAVE 


NG 






0243 


SU61 


SUB 


KOI 








0244 




LRS 


18 








0245 




ORA 


OCTK 








0246 




FAD 


OCTK 








0247 




STO 


TEMPI 


LXOFY-1 FLOATED 






0248 




TXI 


*+l,l,2 


IERRLO+6 






0249 




CLA* 


6,4 


YLO 






0250 




CAS* 


7,4 


AGAINST YHI 






0251 




NOP 




NG 






0252 




TRA 


LEAVE 


NG 






0253 




CLA* 


7,4 


YHI 






0254 




STO 


YHI 








0255 




FSB 


YNEXT 








0256 




FDP 


TEMPI 








0257 




STO 


DELY 


DELY GRTHN ZERO 






0258 


» 












0259 


» NOW 


FIND OUT 


WHETHER YOFX 


IS INCREASING OR DECREASING AND GO 


CHECK 


0260 


» IT. 


ALSO SET YMIN, YMAX. 








0261 


• 












0262 


YOXCK 


TXI 


*+l ,1,-6 


IERRLO ♦ ZERO NOW 






0263 




STZ 


ZFINCR 


SET ZFINCR FOR INCREASING 




0264 




LXD 


LYOFX,2 








0265 


CLAY1 


CLA 


** ,2 


** * A(Y0FX)+1 


YOFX(LYOFX) 




0266 




LDQ* 


1,4 


YOFXU) TO MQ 






0267 




STO 


YMAX 


TRIAL 






0268 




STQ 


YMIN 


SETTINGS 






0269 




CAS* 


1,4 








0270 




TRA 


MONCK 


IS INCREASING, OK 






0271 




TRA 


MONCK 


IS CONSTANT, OK 






0272 




SXD 


ZFINCR, 2 


REVERSE SENSE OF ZFINCR 




0273 




STQ 


YMAX 


AND YMAX 






0274 




STO 


YMIN 


AND YMIN 






0275 


MONCK 


TSX 


$M0N0CK,4 








0276 


TSXY1 


TSX 


** ,0 


** = A(YOFX) 






0277 




TSX 


LYOFX,0 








0278 




TSX 


ZFINCR, 0 








0279 




TSX 


KD1,0 


{ IANSNG,0) 






0280 




TSX 


TEMPI, 0 


( IANS,C) 






0281 




LXD 


IFNCTN-2,4 








0282 




ZET 


TEMPI 








0283 




TRA 


LEAVE 








0284 


* 












0285 


♦ CHEC 


K YLO 


GRTHN- YMIN, 


YHI LSTHN= YMAX 






0286 


» 












0287 




TXI 


•♦1,1,5 


IERRLO+5 






0288 




CLA 


YMIN 








0289 




CAS 


YNEXT 


(YNEXT * YLO) 






0290 




TRA 


LEAVE 


NG 






0291 




NOP 




OK 






0292 




TXI 


*+l,l,l 


OK 






0293 




CLA 


YHI 








0294 




CAS 


YMAX 








0295 




TRA 


LEAVE 


NG 






0296 




NOP 




OK 






0297 


» 












0298 


» FOR 


MONOTONE 


DECREASING, REVERSE YOFX AND THE X 


VARIABLES THEN 


ENTER 


0299 



4) 



• IFNCTN 
(PAGE 5) 



PROGRAM LISTINGS 



•»**»»»*****•»•*#***•*** 

« IFNCTN « 
***«•#•»»•*«*»*»«*****»•• 

(PAGE 5) 



• LOOP 






0300 


• 






0301 


NZT 


ZFINCR 




0302 


TRA 


START 




0303 


TSX 


REV, 2 




0304 


CLA 


XNEXT 




0305 


LDQ 


XL AST 




0306 


STO 


XLAST 




0307 


STQ 


XNEXT 




0308 


CLA 


DELX 




0309 


CHS 






0310 


STO 


DELX 




0311 


» 






0312 


» ENTER LOOP 


WITH XRI « 


IYXNXT * l,2,...,LYOFX 


0313 


• 


XR2 » 


IXYNXT - 1,2,...,LX0FY 


0314 


• 






0315 


START A XT 


ltl 




0316 


AXT 


lt2 




0317 


TRA 


CLA1 




0318 


• 






0319 


» RESET FOR 


NEXT XNEXT » 


FORCING EXACT EQUALITY WITH XLAST FOR 


0320 


» IYXNXT 


* LYOFX 




0321 


• 






0322 


YGRYOX CLA 


XNEXT 




0323 


FAD 


DELX 




0324 


STO 


XNEXT 




0325 


TXL1 TXL 


CLAl,l, •» 


«* * LYOFX-1 


0326 


CLA 


XLAST 




0327 


STO 


XNEXT 




0328 


* 






0329 


» COMPARE YNEXT AGAINST 


YOFX( IYXNXT) 


0330 


* 






0331 


CLA1 CLA 


YNEXT 


(FIRST VALUE = YLO) 


0332 


CAS1 CAS 


»»,1 


♦* a A(YOFX)+l 


0333 


TXI 


YGRYOXt 1 , 


I (BUMP IYXNXT AND GO RESET XNEXT) 


0334 


TRA 


EQUAL 




0335 



YNEXT IS NOW BRACKETED BY 
YOFX( IYXNXT) 



YOFX(IYXNXT-l) LSTHN YNEXT LSTHN 



RESET FOR NEXT 
* LXOFY 



YNEXT, FORCING YNEXT EXACTLY. * YHI FOR IXYNXT 



IT HANDLES THE SPECIAL CASES IN WHICH NSAMEY * 
IN WHICH THE EQUALITIES RUN OFF THE END OF YOFX. 



AND 



EQUAL PXD 
PDX 
LDQ 
TXII TXI 
TXH TXH 
CLA3 CLA 
CAS2 CAS 



0,1 
0,4 

KD1 

•+1,4.1 

COVER, 4, 
♦ »,4 
♦•,4 



COUNT NSAMEY IN MQ 
START IYXTEMP •* IYXNXT+i 
*♦ = LYOFX 

** = A(Y0FX)+1 YOFX( IYXTMP+1) 

«• = A(Y0FX)+2 YOFX(IYXTMP) 



0336 
0337 
0338 



FSB1 


FSB 


**, 1 


** * AtYOFXm 


0339 




STO 


TEMPI 


-( YOFX ( IYXNXT )-YNEXT) 


0340 


CLA2 


CLA 


**, 1 


•» « A(Y0FX)+1 


0341 


FSB2 


FSB 


• ••1 


♦* = A(Y0FX)+2 


0342 




STO 


TEMP2 




0343 




CLA 


TEMPI 




0344 




FDP 


TEMP2 




0345 




FMP 


DELX 




0346 




FAD 


XNEXT 


XNEXT-DELX*(YOFX( IYXNXT >-YNEXT> / 
(YOFX( IYXNXT)-YOFX( IYXNXT-1)) 


0347 
0348 


ST01 


STO 


»*,2 


«* = A(X0FY>*1 


0349 



0350 
0351 
035? 
0353 





CLA 


YNEXT 






0354 




FAD 


DELY 






0355 


TXL3 


TXL 


TXL4,2»*» 


»* * LXOFY-1 


CHECK COMPLETION 


0356 




TRA 


WINDUP 






0357 


TXL4 


TXL 


ST02,2,»* 


** * LXOFY-2 


CHECK FOR LAST Y 


0358 




CLA 


YHI 






0359 


ST02 


STO 


YNEXT 






0360 




TXI 


CAS1,2,1 






0361 












0362 


IF 


YNEXT * 


YOFX( IYXNXT) 


IT MAY ALSO » 


YOFX( IYXNXT+1) ETC. 


0363 


THIS 


ROUTINE 


COUNTS NSAMEY 


= NO. OF SUCH 


EQUALITIES, 


0364 



0365 
0366 
0367 
0368 
0369 
0370 
0371 
0372 
0373 
0374 
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TRA 


COVER 








0375 




XCA 










0376 




ADD 


KD1 


(CAS CAN 


»T JUMP HERE, 


GUARANTEED BY 


0377 


* 






MONOCK) 






0378 




XCA 










0379 




TRA 


TXI1 








0380 


* 












0381 


• THEN 


XOFY(IXYNXT) » XNEXT 


♦ DELX*CNSAMEY-l)/2, 


FOR ANY NSAMEY 


0382 


* 












0383 


COVER 


XCA 










0384 




SUB 


KD1 








0385 




LRS 


18 








0386 




ORA 


OCTK 








0387 




FAD 


OCTK 








0388 




FDP 


K2L 








0389 




FMP 


DELX 








0390 




FAO 


XNEXT 








0391 




TRA 


STOl 








0392 


* 












0393 


♦ FOR MONOTONE 


DECREASING, RE- 


REVERSE 


YOFX 




0394 


* 












0395 


WINDUP 


LXD 


IFNCTN-2,4 








0396 




A XT 


0,1 


IANS=0 SETTING 




0397 




ZET 


ZFINCR 








0398 




TSX 


REV, 2 








0399 














0400 


* EXIT. (ASSUMES XR4 RESTOREO) 






0401 


» 












0402 


LEAVE 


PXD 


0,1 








0403 




STO* 


10,4 


IANS 






0404 




LXD 


IFNCTN-4,1 








0405 




LXD 


IFNCTN-3,2 








0406 




TRA 


11,4 








0407 


* 












0408 


» INTERNAL SUBROUTINE TO REVERSE YOFX 






0409 


» 












0410 


• 


LINKAGE 


XR2, RETURN TO 


1,2 (REFILLS XR4 FROM 


IFNCTN-2* 


0411 


• 












0412 


REV 


TSX 


$REVER,4 








0413 


TSXR1 


TSX 


• *,0 


** = A(YOFX) 




0414 




TSX 


LYOFX, 0 








0415 


TSXR3 


TSX 


**»0 


** - A(YOFX) 




0416 




LXD 


IFNCTN-2,4 








0417 




TRA 


1,2 








0418 


* 












0419 


* CONSTANTS 










0420 


* 












0421 


Kl 


PZE 


1 








0422 


KOI 


PZE 


0,0,1 








042 3 


KD2 


PZE 


0,0,2 








0424 


K2L 


DEC 


2.0 








042 5 


OCTK 


OCT 


233000000000 








0426 


» 












0427 


* VARIABLES 










0428 


* 












0429 


LYOFX 


PZE 


0,0,** 


INPUT 






0430 


LXOFY 


PZE 


0,0,** 


INPUT 






0431 


YHI 


PZE 


**,»#, •« 


INPUT 






0432 


OELX 


PZE 


»», «# t ** 








0433 


DELY 


PZE 


**,«*, »* 








0434 


XNEXT 


PZE 


*« t *• f *# 


XFIRST 


(XLAST) ( +DELX. * • ) 


0435 


YNEXT 


PZE 


**,»*,** 


YLO 


( +DELY. • • ) 


0436 


XLAST 


PZE 


•*,»»,«* 


XLAST 


(XFIRST) 




0437 


YMAX 


PZE 


«»,**, #* 








0438 


YMIN 


PZE 


**,**,•• 








0439 


TEMPI 


PZE 


»♦ , *♦ , •* 








0440 


TEMP2 


PZE 










0441 


ZFINCR 


PZE 


0,0,** 


**=0 IF 


MONO INCR., » 


LYOFX IF HION0 DECR* 


0442 




END 










0443 
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REFER TO REFER TO 

GETX GETX 
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« IINTGR (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0156 

* FAP 0001 
•IINTGR 0002 

COUNT 150 0003 

LBL IINTGR 0004 

ENTRY IINTGR (Y0FX1, YIGRTD, DELX, LY,YOFX, CIGRTN) 0005 

» 0006 

» ABSTRACT 0007 

* 0008 
« TITLE - IINTGR 0009 

* INVERSION OF TRAPEZOIDAL INTEGRAL 0010 
» 0011 
» IINTGR PERFORMS THE INVERSE OPERATION TO THAT OF 0012 

* SUBROUTINE INTGRA, I.E. IT FINDS A VECTOR, YOFX, WHOSE 0013 
» TRAPEZOIDAL INTEGRAL IS A GIVEN VECTOR, YIGRTD. 0014 

* THE INITIAL VALUE OF YOFX IS REQUIRED AS INPUT. THE 0015 

* CONSTANT OF INTEGRATION IS AN OUTPUT. 0016 
» 0017 
» THE OUTPUT VECTOR YOFX MAY REPLACE THE INPUT VfCTOR. 0018 

* 0019 
» LANGUAGE - FAP SUBROUTINE ( FORTRAN- 1 1 COMPATIBLE) 0020 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0021 

* STORAGE - 49 REGISTERS 0022 
» SPEED - 7090 709 7090 709 0023 
» (45.2 OR 47.0) ♦ (37.8 OR 41.0)*LY MACHINE CYCLES* 0024 

* LY » VECTOR LENGTH 0025 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 0026 

* 0027 

* USAGE 0028 

» 0029 

» TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0030 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0031 

* 0032 

* FORTRAN USAGE 0033 

* CALL IINTGR(Y0FX1, YIGRTD, DELX,LY, YOFX, CIGRTN) 0034 

* 0035 
» NOTE THAT THE ARGUMENTS ARE IDENTICAL TO THOSE OF 0036 
» SUBROUTINE INTGRA EXCEPT THAT THE ORDER IS REVERSED. 0037 

* SEE SUBROUTINE INTGRA FOR DETAILED DISCUSSION. 0038 

* 0039 
» INPUTS 0040 
» 0041 

* Y0FX1 STARTING VALUE FOR YOFX(l) 0042 

* 0043 
« YIGRTDU) 1 = 1. ..LY IS THE TRAPEZOI DALLY INTEGRATED VECTOR 0044 

* 0045 
» DELX WAS THE ( NON-ZERO) DELTA X USED IN OBTAINING YIGRTD 0046 
» 0047 

* LY MUST EXCEED ZERO 0048 

* 0049 
» OUTPUTS STRAIGHT RETURN WITH NO ACTION IF LY LSTHN 1 OR DELX * 0. 0050 

* 0051 

* YOFX(I) 1=1. ..LY IS THE VECTOR WHICH INTEGRATES TO YISRTD 0052 

* YOFX(l) = Y0FX1 0053 

* YOFX(K) = ( 2/DELX ) * ( Y IGRTD( K )-Y IGRTD( K-l ) ) - Y0FXIK-1S 0054 

* FOR K = 2,3, ...,LY 0055 
» 0056 
» EQUIVALENCE(YOFX, YIGRTD) IS PERMITTED 0057 

* 0058 

* CIGRTN IS SET = YIGRTDU) 0059 
» 0060 

* EXAMPLES THE EXAMPLES USED HERE ARE THE INVERSES OF THE EXAMPLES 0061 
» USED FOR INTGRA 0062 
» 0063 

* 1. INPUTS - YIK1...7) = 0., 1., 2.,..., 6. YF= 1. 0064 

* YI2U...7) = 0.,10.,20.,..., 60. 0065 
» YI3U...7) = 0.,-2.,-4.,...,-12. 0066 

* YI4U...7) = 1., 2., 3.,..., 7. 0067 

* YI5U...2) = -1., 0. 0068 
» YI6U) = -1., 0069 
» Y7 = C7 » Y8 * C8 * -999. 0070 

* 0071 
» USAGE - CALL I I NTGR( YF, YI1, 1., 7, Yl, CI) 0072 
» CALL I INTGR( YF, YI2, 10., 7, Y2, C2) 0073 

* CALL I INTGR( YF, YI3, -2., 7, Y3, C3) 0074 
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» CALL IINTGRC YF, YI4, i. f 7, Y4, C4) 0075 

* CALL IINTGRC YF, YI5, 1., 2, Y5, C5) 0076 

* CALL I INTGR( YF, YI6, 1., 1, Y6, C6> 0077 
» CALL IINTGRC YF, Yli, 1., 0, Y7, C7I 0078 

* CALL IINTGRC YF, YU, 0., 7, Y8, C8> 0079 

* 0080 

* OUTPUTS - YUI) = Y2CI) = Y3CI) = Y4CI) » 1. FOR I»1...7 0081 
» Y5C1...2) * Y6C1) * 1. 0082 
» C1=0. C2=0. C3=0. C4=l. C5=-l„ C6=-l. 0083 

* Y7=C7=Y8=C8 = -999. C NO OUTPUT CASES) 0084 

* 0085 
» 2. MULTIPLE DIFFERENTIATION WITH OUTPUTS REPLACING INPUTS 0086 

* INPUTS - YI(1..*7> = 0., 1., 6., 19., 44., 85., 146. 0087 
« Y0FX1C1...3) * 0., 0., 4. C NOTE THIS IS REVERSED 0088 
» FROM EXAMPLE FOR INTGRA) 0089 

* USAGE - DO 10 1=1,3 0090 
« 10 CALL IINTGR<Y0FXim,YI,l.,7,YI,CCI>> 0091 

* OUTPUTS - YICl..;7) = 4., 4. ,...,4. CC1...3) = 0.,0.,0. 0092 

* 0093 

* PROGRAM FOLLOWS BELOW 0094 

* 0095 

* 0096 

* NO TRANSFER VECTOR 0097 

HTR 0 XR4 0098 

BCI 1,1 INTGR 0099 

* ONLY ENTRY. 1 1 NTGR C YOFXl , YIGRTD, DELX, LY, YOFX, CIGRTN) 0100 
IINTGR SXD IINTGR-2,4 0101 
» CHECK LY CAT LEAST * 1) AND DELX C NON-ZERO, UNLESS LY = U 0102 

CLA* 4,4 LY 0103 

TMI LEAVE 0104 

PDX 0,4 0105 

TXL LEAVE, 4,0 0106 

SXD TXL, 4 STORE LY IF OK. 0107 

TXL LXD4,4,1 AVOID DELX BUSINESS IF LY = 1 0108 

LXD IINTGR-2,4 0109 

CLA* 3,4 DELX 0110 

TZE LEAVE 0111 

STO TWOVDX CTEMP FOR DELX) 0112 

CLA FL2 0113 

FDP TWOVDX 2.0/DELX 0114 

STO TWOVDX 0115 

* SET OUTPUTS FOR LY AT LEAST = 1 0116 
LXD4 LXD IINTGR-2,4 0117 

CLA* 2,4 YIGRTDC1) 0118 

STO LASTYI SAVE FOR LOOP 0119 

STO* 6,4 AND STORE IN CIGRTN 0120 

CLA* 1,4 YOFXl 0121 

STO* 5,4 Y0FXC1) 0122 

* THEN SET LOOP FOR LARGER LY 0123 

CLA 2,4 0124 

ADD Kl AC YIGRTD)+1 0125 

STA GET 0126 

CLA 5,4 0127 

ADD Kl AtYOFX)+l 0128 

STA STORE 0129 

ADD Kl ACY0FXU2 0130 

STA SUB 0131 

* BUT BYPASS THE LOOP IF LY*1 0132 

LXD TXL t4 0133 

TXL LEAVE, 4,1 0134 

* OTHERWISE GO AHEAD WITH LOOP 0135 

AXT 2t4 0136 

* LOOP TO SET Y0FXC2...LY) 0137 
GET LDQ **,4 ** = AC Y IGRTD) +1 0138 

CLS LASTYI 0139 

STQ LASTYI 0140 

FAD LASTYI YI GRTDC K)— Y IGRTDf K-l 3 0141 

XCA 0142 

FMP TWOVDX TIMES 2/DELX 0143 

SUB FSB **,4 **=ACY0FX)*-2 MINUS YQFXCK-1) 0144 

STORE STO **,4 **=A C YOFX ) +1 BECOMES YOFX(K) 0145 

TXI *+l,4,l 0146 

TXL TXL GET, 4,** **= LY 0147 

* EXIT 0148 
LEAVE LXD IINTGR-2,4 0149 
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TRA 7,4 0150 

* CONSTANTS, TEMPORARIES 0151 

FL2 DEC 2.0 0152 

Kl P7E 1 0153 

LASTYI PZE **,»»,*♦ * PREVIOUS YIGRTD VALUE, START YIGRTDU) 0154 

TWOVDX PZE *#,**,** = 2.0/DELX 0155 

END 0156 
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• INDATA (SUBROUTINE) 10/1/64 LAST CARD IN DECK IS NO. 0488 

« LABEL 0001 

CINDATA 0002 

SUBROUTINE INDATA ( IT APE, IRECNO, NOPTS, DAT A, ERR) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - INDATA 0007 

C FAST AND CONVENIENT RETRIEVAL OF DATA FROM A SPECIAL TAPE 0008 

C 0009 

C INDATA SEARCHES A TAPE CONSISTING OF MANY DATA SERIES AND 0010 

C OTHER INFORMATION ABOUT EACH SERIES. THE REQUESTED 0011 

C INFORMATION IS RETURNED TO THE CALLING PROGRAM. THE 0012 

C DETAILS OF THE TAPE LAYOUT ARE DESCRIBED ALONG WITH THE 0013 

C SUBROUTINE OUDATA. 0014 

C 0015 

C INDATA ACQUIRES ITS SPEED PRIMARILY THROUGH 1) HIGH 0016 

C SPEED TAPE SCANNING ALONG WITH INTERNAL TABLES OF DATA 0017 

C POSITION AND 2) BY ITS ABILITY TO READ DATA OF LIMITED 0018 

C ACCURACY FROM A TIGHTLY PACKED FORMAT, FOR EXAMPLE, DATA 0019 

C WITH AN ACCURACY OF ONE PART IN 4096 CAN BE STORED ON 0020 

C ONE THIRD THE TAPE THAT WOULD BE REQUIRED USING FORTRAN 0021 

C BINARY TAPE PROCEDURES. 0022 

C 0023 

C INDATA ACQUIRES ITS CONVENIENCE THROUGH THE FACTS THAT 0024 

C 1) THE PROGRAMMER HAS BOTH THE DATA, AND INFORMATION ABOUT 0025 

C THE DATA AVAILABLE BY MEANS OF A SINGLE CALL STATEMENT 0026 

C 2) THE PROGRAMMER NEED NOT KNOW ANY DETAILS ABOUT DATA 0027 

C ARRANGEMENT, PACKING, TAPE POSITION, ETC. 0028 

C 0029 

C THE INDATA-OUDATA SYSTEM INCLUDES PROGRAMMED SUMCHECKS 0030 

C ON DATA STORAGE AND RETRIEVAL WHICH ARE INDEPENDENT OF 0031 

C BUILT-IN HARDWARE CHECKS. 0032 

C 0033 

C LANGUAGE - FORTRAN II, SUBROUTINE, (WITH SUBROUTINES IN FAR) 0034 

C EQUIPMENT - 709 OR 7090 (DATA CHANNEL AND ONE TAPE UNIT! 0035 

C STORAGE - 896 REGISTERS 0036 

C SPEED - 0037 

C AUTHOR - J.F. CLAERBOUT 0038 

C 0039 

C USAGE 0040 

C 0041 

C TRANSFER VECTOR CONTAINS ROUTINES - FAPSUM, FSK I P ,LOC , MVBLOK ^UNPAKN, 0042 

C VARARG, XSAME, 0043 

C AND FORTRAN SYSTEM ROUTINES - ( F IL ) , ( RLR ) , ( SPH ) , ( STH ) 4 ( TSB) • 0044 

C 0045 

C FORTRAN USAGE 0046 

C CALL INDATAUTAPE, IRECNO, NOPTS, DATA, ERR, ...*..) 0047 

C THE NUMBER OF ARGUMENTS IN THE CALL STATEMENT IS VARIABLE 0048 

C DEPENDING ON THE DESIRED INFORMATION, SEE EXAMPLES. 0049 

C 0050 

C INPUTS 0051 

C 0052 

C ITAPE IS THE LOGICAL TAPE NUMBER TO BE SEARCHED AND READ. IF 0053 

C MORE THAN 2 DIFFERENT TAPE UNITS ARE TO BE USED DURING 0054 

C ONE JOB, IT WILL BE NECESSARY TO CHANGE THE FIRST 0055 

C DIMENSION CARD IN THIS PROGRAM. THIS IS DESCRIBED JUST 0056 

C PRECEDING THAT CARD. 0057 

C 0058 

C IRECNO THE REQUESTED DATA RECORD NUMBER. THE RECORD NUMBERS OF 0059 

C THE DATA RECORDS ON THE TAPE ARE SUPPLIED BY THE PERSONS 0060 

C WHO ORIGINATED THE TAPE. THE NUMBERS MAY BE FIXED POINT, 0061 

C FLOATING POINT, OCTAL, OR ALPHANUMERIC. 0062 

C IF THE USER IS INTERESTED IN MERELY READING THE DATA 0063 

C RECORDS IN THE SEQUENCE THAT THEY OCCUR ON THE TAPE, HE 0064 

C MAY SET IRECNO^O IN WHICH CASE THE NEXT RECORD IS READ 0065 

C AND ITS ACTUAL RECORD NUMBER WILL BE RETURNED AS IRECNO. 0066 

C 0067 

C NOPTS NORMALLY THIS IS NOT AN INPUT. IF HOWEVER THE PROGRAM- 0068 

C MER IS NOT REQUESTING DATA, BUT ONLY INFORMATION ABOUT 0069 

C THE DATA, SUBSTANTIAL TIME CAN BE SAVED BY AVOIDING THE 0070 

C ACTUAL DATA READ AND INTERPRETATION. THE DATA WILL NOT 0071 

C BE READ IF NOPTS IS SET MANY NEGATIVE NUMBER) BEFORE 0072 

C CALLING INDATA. 0073 

C 0074 
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C »**»*»»**SEE ALSO ((SPECIAL REQUESTS)) BELOW FOR MORE INPUTS. 0075 

C 0076 

C OUTPUTS 0077 

C 0078 

C OATA(I) 1=1, NOPTS IS THE RETURNED DATA SERIES. NORMALLY THIS IS 0079 

C ASSUMED FLOATING POINT UNLESS OTHERWISE SPECIFIED BY THE 0080 

C ORIGINATOR OF THE TAPE. DATA MUST BE DIMENSIONED TO THE 0081 

C MAXIMUM OF EITHER 1) NOPTS+1 OR 2) SOME NUMBER DEPENDING 0082 

C ON THE AMOUNT OF INFORMATION STORED ABOUT THE DATA. 4 .AS- 0083 

C SUME 200 UNLESS SPECIFIED OTHERWISE BY ORIGINATOR OF TAPE 0084 

C 0085 

C ERR SPECIFIES AN ERROR CONDITION 0086 

C =0. IMPLIES NO ERROR CONDITION 0087 

C »i. REQUESTS NOT ON TAPE* ALL ELSE RETURNED PROPERLY 0088 

C =2. SUMCHECK ERROR ON TAPE, EVERYTHING RETURNED AS WELL 0089 

C AS POSSIBLE. 0090 

C =3. PROGRAM TRIED TO USE MORE TAPES THAN THERE ARE 0091 

C TABLES DIMENSIONED. SEE INPUTS- ITAPE. 0092 

C =4. END DATA INFORMATION ON TAPE (I.E. THE RECORD NO. 0093 

C CALLED WAS NOT FOUND). 0094 

C =5. ILLEGAL LENGTH OF CALL STATEMENT. I.E. CALL 0095 

C INDATA( ARG1,ARG2, ARGN) N MUST BE ODD. 0096 

C =6. MORE DATA RECORDS ON TAPE THAN SIZE OF INTERNAL 0097 

C BUFFER. CHANGE DIMENSION STATEMENT BELOW FOR IRECTB AND 0098 

C DEFINITION OF MAXREC. 0099 

C 0100 

C WHEN AN ERROR CONDITION OCCURS, ERR, ITAPE, IRECNO, 0101 

C AND THE REQUEST (IF ERR = 1.) ARE PRINTED ON-LINE. 0102 

C 0103 

C IRECNO IF IRECNO WAS SET *0 ON INPUT THEN IT WILL BE RESET TO 0104 

C THE RECORD NUMBER FOUND NEXT ON THE TAPE. 0105 

C 0106 

C NOPTS IF NOPTS WAS SET LSTHN 0 THEN THE CORRECT NOPTS FOR 0107 

C THE IRECNO IS RETURNED. 0108 

C 0109 

C #*#»«***»#SEE ALSO ( ( SPECIAL REQUESTS)) BELOW FOR MORE OUTPUTS. 0110 

C 0111 

C SPECIAL REQUESTS 0112 

C 0113 

C INDATA IS A DEPARTURE FROM NORMAL FORTRAN PROGRAMMING IN THAT 0114 

C THE CALLING PROCEDURE DEPENDS ON THE NEEDS OF THE PROGRAMMER. 0115 

C THIS IS BEST EXPLAINED THRU THE EXAMPLES. THE BASIC IDEA IS 0116 

C THAT ONE GENERALLY NEEDS MORE THAN JUST RAW DATA. IN SEISMIC TIME 0117 

C SERIES FOR EXAMPLE ONE OFTEN ALSO NEEDS VARIOUS INFORMATION ABOUT 0118 

C THE SEISMIC EVENT, ITS RECORDING, AND TTS DIGITIZATION. GENERALLY 0119 

C THE ORIGINATOR OF THE TAPE WILL SUPPLY ALL OF THIS INFORMATION ON 0120 

C THE TAPE. IF THIS INFORMATION IS ON THE TAPE AND IF THE PROGRAMMER 0121 

C REQUESTS ANY PORTION OF IT, INDATA WILL RETURN HIS REQUEST. A 0122 

C REQUEST IS MADE BY MEANS OF A NAME (6 CHARACTERS OR LESS) SUPPLIED 0123 

C BY THE TAPE ORIGINATOR. FOR EXAMPLE THE NAME ((DELTAT)) MIGHT 0124 

C REFER TO THE DIGITIZATION SAMPLING TIME OF THE DATA. 0125 

C 0126 

C A MAXIMUM OF 25 SPECIAL REQUESTS IS ALLOWED. 0127 

C 0128 

C EXAMPLES .0129 

C IN THE FOLLOWING EXAMPLES THE VARIABLE NOPTS IS ASSUMED 0130 

C TO BE NON-NEGATIVE ON ENTRY TO INDATA, EXCEPT AS NOTED. 0131 

C 0132 

C 1. USAGE - CALL INDATA I 9, 63, NOPTS, DATA, ERR ) 0133 

C OUTPUTS - TAPE NUMBER 9 IS SCANNED IN SEARCH OF DATA RECORD NUMBER 0134 

C 63 (WHICH IS GENERALLY NOT THE 63RD RECORD ON THE TAPE ) . 0135 

C WHEN IT IS FOUND, NOPTS IS SET TO THE NUMBER OF POINTS IN 0136 

C THE DATA RECORD, ( DAT A ( I ) , 1= 1, NOPTS ) IS RETURNED AND ERR 0137 

C IS SET =0 0138 

C 0139 

C 2. INPUTS - IRECNO = 0 0140 

C USAGE - CALL INDATA( 9, IRECNO, NOPTS, DATA, ERR ) 0141 

C OUTPUTS - INSTEAD OF SCANNING THE TAPE THE NEXT RECORD IN POSITION 0142 

C IS READ. ITS RECORD NUMBER IS RETURNED AS IRECNO. OTHER- 0143 

C WISE THE READ OCCURS AS IN EXAMPLE 1. 0144 

C 0145 

C 3. USAGE - CALL INDATA ( 9 , 62, NOPTS, DAT A, ERR, 6HDELTAT, DT) 0146 

C OUTPUTS - THIS IS LIKE EXAMPLE 1. EXCEPT FOR THE INCLUSION OF TWO 0147 

C MORE ARGUMENTS FOLLOWING ERR. THE FIRST OF THESE, 0148 

C (DELTAT) IS THE NAME WHICH WE CONVENTIONALLY USE FOR 0149 
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C THE TIME SAMPLING OF THE DATA SERIES. THUS IF ONE OF 0150 

C OUR SEISMIC TAPES WERE ON TAPE DRIVE 9, SEISMIC RECORD 0151 

C 62 WOULD BE FOUND AND READ INTO DATAU ) , 1*1, NOPTS, 0152 

C NOPTS WOULD BE SET =3301 , DT WOULD BE SET =.05 INDICAT- 0153 

C ING 3301 POINTS WERE DIGITIZED AT 20 POINTS PER SECOND. 0154 

C GENERALLY THEN, AFTER ERR IN THE CALLING SEQUENCE 0155 

C APPEAR ARGUMENTS IN PAIRS, THE FIRST BEING THE NAME OF 0156 

C THE REQUEST, THE SECOND MEMBER OF THE PAIR BEING THE 0157 

C FORTRAN VARIABLE NAME OF THE REQUESTED INFORMATION. SEE 0158 

C THE FOLLOWING EXAMPLE. 0159 

C 0160 

C 4. USAGE - DIMENSION TUO) 0161 

C CALL INDATAI9, 62, NOPTS, DATA, ERR, 5HTITLE,T,6HDELTAT, 0162 

C DT,3HJ08,J) 0163 

C OUTPUTS - THIS IS JUST LIKE EXAMPLE 3. EXCEPT THAT MORE SPECIAL 0164 

C REQUESTS ARE MADE. NOTICE THAT THE SPECIAL REQUEST 0165 

C (TITLE) IS A VECTOR AND THEREFORE IS DIMENS lONEDi REQUEST 0166 

C (JOB) IS FIXED POINT HENCE (J) IS A FIXED POINT VARIABLE 0167 

C NAME. 0168 

C 0169 

C 5. USAGE - NOPTS = -1 0170 

C CALL I ND AT A (9, 62, NOPTS, DATA, ERR, 6HDELTAT#DT) 0171 

C OUTPUTS - THIS IS JUST LIKE EXAMPLE 3. EXCEPT THAT DATA(l) IS N0T 0172 

C READ FROM THE TAPE RESULTING IN A SUBSTANTIAL TIME SAVING 0173 

C NOPTS AND DT ARE RETURNED AS IN EXAMPLE 3. DATA MUST 0174 

C STILL BE DIMENSIONED AS IN EXAMPLE 3. 0175 

C 0176 

C 0177 

C THE FOLLOWING EXAMPLES ARE TESTS THAT ARE TO VERIFY THAT ALL OF THE 0178 

C FEATURES OF INDATA ACTUALLY WORK. A SPECIAL INDATA-OUDATA TYPE 0179 

C TAPE IS GENERATED FOR EACH TEST. 0180 

C 0181 

C 6. TEST OF SEARCHING A8ILITY ON 1 TAPE UNIT 0182 

C INPUTS - I TAPE * 9 IRECNOI 1 . . . 10) » 1,5,9,4,4,4,4,3,2,1 0183 

C USAGE - C FIRST CONSTRUCT A TAPE WITH 10 FILES. EACH FILE 0184 

C C HAVING 1 UNPACKED INTEGER DATA POINT IDENTICAL WITH 0185 

C C THE RECORD NUMBER, AND WITH NO AUXILIARY INFO; 0186 

C DIMENSION 1(3) 0187 

C REWIND ITAPE 0188 

C DO 10 1*1,10 0189 

C CALL OUDATA ( ITAPE, I , 1, I , 1) 0190 

C 10 CONTINUE 0191 

C CALL OUDATA ( ITAPE, 0, 1, DATA, 1 ) 0192 

C REWIND ITAPE 0193 

C C 0194 

C C NOW TEST INDATA 0195 

C DO 10 1=1,10 0196 

C CALL INDATA ( ITAPE, IRECNO( I ) , NOPTS, DATA! I ),ERRl I )) 0197 

C 10 CONTINUE 0198 

C OUTPUTS - DATAU... 10) * 1,5,9,4,4,4,4,3,2,1 N0PTS=1 0199 

C ERR (1...10) * 0,0,0,0,0,0,0,0,0,0 0200 

C 0201 

C 7. TEST OF SEARCHING ABILITY ON 2 TAPE UNITS (AND ILLUSTRATE USE OF 0202 

C NON-FIXED POINT RECORD NUMBERS. 0203 

C INPUTS - ITAPE(1...10) * 9,12, 9, 9,12,12, 9, 9,12, 9 0204 

C- IRECNO( 1...10) * 1,1., 5, 4, 9. ,5., 4, 4,3. * 7 0205 

C USAGE - C ASSUME TWO TAPES CONSTRUCTED AS IN EXAMPLE 6. 0206 

C C LOGICAL TAPE 9 CONTAINS FIXED POINT INTEGERS FOR 0207 

C C RECORD NUMBERS AND UNPACKED DATA, 0208 

C C LOGICAL TAPE 12 CONTAINS FLOATING POINT INTEGERS 0209 

C C 0210 

C DO 10 1=1,10 0211 

C CALL INDATA ( I TAPE ( I ) , IRECNO( I ), NOPTS, DATA! I )t 0212 

C I ERR ( I ) ) 0213 

C 10 CONTINUE 0214 

C OUTPUTS - DATAU. ..10) = 1,1., 5, 4, 9. ,5., 4, 4,3., 7 0215 

C ERR U...10) = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 0216 

C 0217 

C 8. TEST OF SEQUENTIAL READING OF RECORDS 0218 

C INPUTS - ITAPE « 9 IRECNO( 1...5) = 0,0,0,0,0 0219 

C USAGE - C ASSUME A DATA TAPE CONSTRUCTED AS IN EXAMPLE 6. 0220 

C C 0221 

C REWIND ITAPE 0222 

C DO 10 1=1,5 0223 

C CALL INOATA ( ITAPE, IRECNOt I ), NOPTS, DATA ( I ) ,ERR( I ) I 0224 
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c 
c 
c 

C12. 

c 
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10 CONTINUE 
OUTPUTS - IRECNOC 1...5) * 1,2,3,4,5 
DATA II. ..53 = 1,2,3,4,5 
ERR ( 1...5) = 0,0,0,0,0 

TEST OF NON-RETURN OF OATA ANO GETTING SPECIAL REQUESTS. 
INPUTS - (FOR CALLING INDATA) 

ITAPE =12 IRECNO = 0 NOPTS = -1 



USAGE 



- C 
C 
C 
C 
C 
C 



CONSTRUCT A DATA TAPE WITH AUXILIARY INFORMATION 
FOR THIS PURPOSE LET 
DT = .05 

TITLEU...8) = 6H REPRESENTATIVE TITLt POR REC. 
OATA (1...51 = L,2.,3.,4.,5. 

REWIND 12 

CALL 0UDATA(12,6HSAMPLE,5,DATA,3, 

1 6HDELTAT, 1,DT 

2 5HTITLE ,8, TITLE) 
CALL OUDATA ( 12,0, 1, DATA, 1) 

REWIND 12 

DIMENSION DATA SO THAT INDATA WILL HAVE COMPUTATION 
SPACE - EVEN THOUGH DATA IS NOT WANTED. 
DIMENSION DATA(200),TITLE(8) 



OUTPUTS 



CALL INDATA I ITAPE, IRECNO, NOPTS, DATA* ERR # 
1 6HDELTAT, DT, 

5HTITLE , TITLE) 
IRECNO * 6HSAMPLE NOPTS =5 ERR * 0. 
DATA CONTAINS MEANINGLESS NUMBERS 

DT * .05 TITLE! I. ..8) » 6H REPRESENTATIVE TITLE FOR REC 



TEST OF ERROR CONDITION - REQUESTS NOT ON TAPE, ALL ELSE RETtJRNED 
INPUTS - ITAPE = 12 IRECNO » 0 NOPTS = 0 

USAGE - C ASSUME A DATA TAPE CONSTRUCTED AS IN EXAMPLE 9* 

C 

C DIMENSION DATA(200),TITLE(8) 

REWIND ITAPE 

CALL INDATA ( ITAPE, IRECNO, NOPTS, DATA, ERR, 

1 6HDELTAT, DT 

2 6HN0 REQ,NON) 

OUTPUTS - IRECNO = 6HSAMPLE DATA( 1...5) * 1 . , 2. , 3. , 4. , S. 
ERR * 1.0 DT = .05 NOPTS « 5 

ANO ON-LINE PRINTED MESSAGE 
NO REQ 

ERROR IN SUBROUTINE INOATA, ERROR CODE * 1*, TAPE*12 
RECORD NUMBER IN OCTAL* 622144474325 

TEST ERROR CONDITION - SUMCHECK ERROR ON TAPE, EVERYTHING 

RETURNED AS WELL AS POSSIBLE. 
- ITAPE =12 IRECNO * 0 



INPUTS 
USAGE 



- C CONSTRUCT A DATA FILE WITH AUXILIARY INFORMATION 

C BUT CHANGE THE SUMCHECK ON THE DATA 

C LET DATAU...5) = 1. , 2. , 3. , 4. , 5. ZERO * o. 

REWIND 12 

CALL 0UDATA(12,6H ERROR, 5, DATA, 1.6HDELTAT, 1,0T1 
BACKSPACE 12 
BACKSPACE 12 

WRITE TAPE 12, ( DATA( I ), 1=1,5) , ZERO 
END FILE 12 

CALL OUDATA ( 12, 0, 1 , DATA, 1 ) 
REWIND 12 



C TEST INDATA 

CALL INDATA ( ITAPE, I RECNO, NOPTS, DATA, ERR, 
1 6H0ELTAT , DT ) 

OUTPUTS - IRECNO = 6H ERROR NOPTS = 5 DATAI1...5) * 1. , 2. ,3. ,4. ,5 
ERR = 2.0 DT = .05 AND ON-LINE MESSAGE (SEE EX. 101 

TEST ERROR CONDITION - PROGRAM TRIED TO USE MORE TAPES THAN 

THERE ARE TABLES DIMENSIONED 
INPUTS - ITAPEU...3) * 9,12,11 N0PTSU...3) = -1,-1,-1 

IRECN0(1...3)= 0, 0, 0 
USAGE - C ASSUME TWO TAPES ARE SET UP AS IN EXAMPLE 7. 

C THERE IS NO NEED TO SET UP A TAPE ON LOGICAL 



0225 
0226 
0227 
0228 
0229 
0230 
0231 
0232 
0233 
0234 
0235 
0236 
0237 
0238 
0239 
0240 
0241 
0242 
0243 
0244 
0245 
0246 
0247 
0248 
0249 
0250 
0251 
0252 
0253 
0254 
0255 
0256 
0257 
0258 
0259 
0260 
0261 
0262 
0263 
0264 
0265 
0266 
0267 
0268 
0269 
0270 
0271 
0272 
0273 
0274 
0275 
0276 
0277 
0278 
0279 
0280 
0281 
0282 
0283 
0284 
0285 
0286 
0287 
0288 
0289 
0290 
0291 
0292 
0293 
0294 
0295 
0296 
0297 
0298 
0299 
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C C UNIT 11 BECAUSE INOATA WILL NEVER GET THERE* 0300 

C C 0301 

C DO 10 1=1,3 0302 

C CALL INDATA ( ITAPE( I) , IRECNOC I ),NOPTS(I ) tDATA, 0303 

C 1 ERR(I>) 0304 

C 10 CONTINUE 0305 

C OUTPUTS - ERR(1.*.3> * 0.,0.,3. AND ON-LINE MESSAGE (SEE EX. 10S 0306 

C 0307 
C13. TEST ERROR CONDITION - END DATA INFORMATION ON TAPE (RECORD NO* 0308 

C CALLED FOR WAS NOT FOUND) 0309 

C INPUTS - ITAPE * 9 IRECNO = 41 0310 

C USAGE - C ASSUME A DATA TAPE CONSTRUCTED AS IN EXAMPLE 6. 0311 

C C 0312 

C CALL INDATA ( ITAPE. IRECNO, NOPTS, DATA, ERR * 0313 

C OUTPUTS - ERR = 4,0 AND ON-LINE MESSAGE (SEE EX. 10) 0314 

C 0315 

C14. TEST ERROR CONDITION - ILLEGAL LENGTH OF CALL STATEMENT 0316 

C INPUTS - ITAPE * 12 IRECNO = 0 0317 

C USAGE - CALL INDATA ( ITAPE, IRECNO, NOPTS, DATAfERR* 0318 

C 1 6HDELTAT) 0319 

C OUTPUTS - ERR = 5. AND ON-LINE MESSAGE (SEE EX. 10) 0320 

C 0321 

C15. TEST ERROR CONDITION - MORE RECORDS ON TAPE THAN SIZE OF 0322 

C INTERNAL BUFFER OF INDATA. 0323 

C INPUTS - ITAPE * 9 IRECNO » 105 0324 

C USAGE - C CONSTRUCT A DATA TAPE AS IN EXAMPLE 6 EXCEPT 0325 

C C PUT 110 FILES ON IT RATHER THAN 10. 0326 

C C 0327 

C CALL INDATA ( I TAPE , I RECNO, NOPTS, DATA, ERR > 0328 

C OUTPUTS - ERR * 6. AND ON-LINE MESSAGE (SEE EX. 10) 0329 

C 0330 

C PROGRAM FOLLOWS BELOW 0331 

C 0332 

C LET NTAPES BE THE NUMBER OF DATA TAPES BEING READ AND 0333 

C LET MAXREC BE THE MAXIMUM NUMBER OF DATA RECORDS, 0334 

C THEN A DIMENSION STATEMENT OF THE FOLLOWING TYPE IS NEEDED. • • 0335 

C DIMENSION I RECTB (MAXREC, NT APES), IPOSIT(NTAPES), LOG I CL( NTAPES) , 0336 

C 1LENTBL( NTAPES) 0337 

C FOR EXAMPLE THREE CARDS OF THE FOLLOWING FORM MUST BE PRESENT 0338 

NTAPES=2 0339 

MAXREC*100 0340 

DIMENSION IRECTB( 100, 2 ) , I POS I T ( 2 ) , LOGI CL ( 2 ) , LENTBL ( 2 ) 0341 

C 0342 

C 0343 

C DO NOT CHANGE THE FOLLOWING CARDS 0344 

DIMENSION L0CS(50),REQS(2,25),DATA(5000) 0345 

EQUI VALENCE ( L0CS( 6),REQS(1) ) 0346 

C SET UP VARIABLE LENGTH CALL AND RETURN 0347 

CALL VARARG ( LOCS ) 0348 

GO TO 20 0349 

10 RETURN 0350 

20 CONTINUE 0351 

C IS THE CALLING SEQUENCE LEGAL... (ODD NO. OF ARGUMENTS) 0352 

LCALL*0 0353 

22 LCALL=LCALL*1 0354 

IF(LOCS(LCALL) )22,24, 22 0355 

24 IF(XM0DF(LCALL,2))26,28,26 0356 

26 ERR=5. 0357 

GO TO 310 0358 

28 CONTINUE 0359 

ERR=0. 0360 

NOPTSS=NOPTS 0361 

C IS ITAPE ON TABLE OF LOGICAL TAPE NUMBERS 0362 

DO 30 I -1 , NTAPES 0363 

IUNIT=I 0364 

IF UTAPE-LOGICLU ) ) 30,60,30 0365 

30 CONTINUE 0366 

C NO, IS THERE ROOM ON LIST OF TAPE NUMBERS FOR ITAPE 0367 

DO 40 1*1, NTAPES 0368 

IUNIT=I 0369 

IF(LOGICL( I ) ) 40,50,40 0370 

40 CONTINUE 0371 

C IF PROGRAM GETS HERE, THERE ARE TOO MANY TAPES BEING REFERRED TO 0372 

ERR-3. 0373 

GO TO 290 0374 
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C PUT I TAPE ON LIST OF TAPE NUMBERS 0375 

50 LOGICLUUNIT) = ITAPE 0376 

60 CONTINUE 0377 

C NOW WE KNOW WHICH TAPES ARE READ, AND WHICH TABLES TO REFER TO 0378 

C IF THE REQUESTED RECNO IS ZERO* WE AVOIO IRECTB SCAN 0379 

IF(IRECNO) 70,100,70 0380 

70 CONTINUE 0381 
C IS REQUESTED RECORD ON IRECTB (FIRST TIME THRU, J=0, DOESNT MATTER! 0382 

J-LENTBL ( IUNIT ) 0383 

DO 80 1=1, J 0384 

1 1 = 1 0385 

IF( IRECNO— IRECTB ( I , IUNIT ) ) 80,90,80 0386 

80 CONTINUE 0387 

C NOT ON IRECTB 0388 

C SKIP TAPE TO END OF KNOWN PORTION 0389 

CALL FSKIP(ITAPE,LENTBL( IUNIT )- IPOS IT ( IUNIT) ) 0390 

IP0SITUUNIT)=LENTBL(IUNIT) 0391 

GO TO 100 0392 

90 CONTINUE 0393 

C SKIP TO CORRECT POSITION ON TAPE, FSKIP IS FILE SKIPPING ROUTINE 0394 

C (IPOSIT IS TAPE FILES FROM BEGINNING OF TAPE) 0395 

CALL FSKIP(ITAPE,II-1-IP0SIT( IUNIT)) 0396 

IPOSITUUNITMII-l 0397 

100 CONTINUE 0398 

C READ NEXT SEISMOGRAM FROM DATA TAPE 0399 

C READ ABOUT TAPE LAYOUT 0400 

READ TAPE I TAPE, I REC , N ALPHA , NOPTS , MODCOD, SCALE 0401 

C AT END OF TAPE YET 0402 

IF(IREC) 120,110,120 0403 

110 ERR=4. 0404 

115 CALL FSKIP( ITAPE,-1) 0405 

GO TO 290 0406 

120 CONTINUE 0407 

C IS IREC ALREADY ON TABLE... 0408 

C YES, NO, IMPOSSIBLE 0409 

IF ( I POSI T( I UNI T ) -LENT BL ( IUN IT ) ) 127, 124,124 0410 

C NO, AUGMENT TABLE LENGTH COUNTER, ADD IREC TO TABLED 0411 

124 CONTINUE 0412 
LENTBH IUNIT )=LENTBL( IUNIT ) + i 0413 
IF(LENTBLUUNIT)-MAXREC) 126,126,125 0414 

125 ERR=6. 0415 
GO TO 115 0416 

126 J=LENTBL( IUNIT) 0417 
IRECTB(J,IUNIT)= IREC 0418 

127 CONTINUE 0419 
C AUGMENT TAPE POSITION COUNTER 0420 

I POSI T( IUNIT MI POSI T( IUNIT ) + l 0421 

C IS THIS THE DESIREO RECORD 0422 

C IF IRECNO IS ZERO WE TAKE ANY RECORD 0423 

IF (IRECNO) 130,138,130 0424 

130 IF( IRECNO-IREC)135,140, 135 0425 

135 CALL FSKIP( ITAPE,1) 0426 

GO TO 100 0427 

C YES, THIS IS THE DESIRED RECORO 0428 

138 IRECNO * IREC 0429 

140 CONTINUE 0430 

C PREPARE TO READ AUX INFO BLOCK 0431 

READ TAPE I T APE , ( DAT A ( I ) , I* 1 , NALPHA ) 0432 

CALL FAPSUM( NALPHA— 1 , DAT A, SUMCK ) 0433 

IF ( DATA( NALPHA J-SUMCK ) 150,160, 150 0434 

150 ERR=2. 0435 

160 CONTINUE 0436 

C PICK UP A REQUEST 0437 

170 J=0 0438 

CALL LOC ( REQUES, LR ) 0439 

180 J=J+1 0440 

C END OF "REQUESTS YET... 0441 

IF(REQS(1,J) ) 185,260, 185 0442 

185 CALL MVBLOKt 1,REQS( 1, J) ,LR) 0443 

C SCAN AUX. BLOCK TO SEE IF REQUEST WAS ON TAPE 0444 

190 1=1 0445 

200 ALPHA=OATA( I ) 0446 

LBLOK=XSAMEF(DATA( I +1 ) ) 0447 

IF ( REQUES-ALPHA) 210,250,210 0448 

C HAS ALL OF AUX BLOK BEEN SCANNED WITHOUT SUCCESS 0449 
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210 


IF( ALPHA ) 240,220,240 




0450 


220 


ERR=1. 




0451 




PRINT 230,REQUES 




0452 




WRITE OUTPUT TAPE 2,230, REQUES 




0453 


230 


FORMAT ( 1H ,A6) 




0454 




GO TO 180 




0455 


240 


I*I+2+LBL0K 




0456 




GO TO 200 




0457 


C 


MOVE REQUEST TO CALLING PROGRAM 




0458 


250 


CALL L0C<DATAU+2),L) 




0459 




CALL MVBLOM LBLOK»L»REQS 12, J) ) 




0460 




GO TO 180 




0461 


C 


ALL SET TO GET DATA. 




0462 


C 


IF NOPTS WAS NEGATIVE, SKIP OVER DATA 




0463 


260 


CONTINUE 




0464 




IF (NOPTSS) 280,270, 270 




0465 


C 


COMPUTE LENGTH OF DATA BLOCK < DON'T FORGET 


SUMCHECK) 


0466 


270 


N= ( NOPTS+MODCOD-1 ) /M0DC0D+ 1 




0467 




READ TAPE I TAPE, { DAT A ( I ) , 1= 1 , N) 




0468 




CALL FAPSUM(N-1,DATA,SUMCK) 




0469 




IF(DATA(N)-SUMCK) 272,275,272 




0470 


272 


ERR-2* 




0471 


275 


CALL UNPAKNIMODCOD, NOPTS, DAT A, SCALE) 




0472 


C 


PASS OVER END OF FILE MARK 




0473 


280 


CALL FSKIPUTAPE,1) 




0474 




IF (ERR) 290,10,290 




0475 


C 


ERROR PRINT 




0476 


290 


CONTINUE 




0477 




IF(ERR-4. ) 310,300,310 




0478 


300 


IF (IRECNO) 310,305,310 




0479 


305 


ERR«0. 




0480 




GO TO 10 




0481 


310 


CONTINUE 




0482 




PRINT 320, ERR, ITAPE, IRECNO 




0483 




WRITE OUTPUT TAPE 2, 320, ERR, ITAPE, IRECNO 




0484 


320 


FORMAT I 41H ERROR IN SUBROUTINE INDATA, 


ERROR CODE =,F3<iO, 


0485 




17H, TAPE=,I2,25H RECORD NUMBER IN OCTAL*, 


015) 


0486 




GO TO 10 




0487 




END 




0488 
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► INDEX 



INDEX 


(FUNCTIONS) 9/4/64 


LAST CARD IN DECK IS NO* 0269 


FAP 




0OO1 






0002 


COUNT 


300 


0003 


LBL 


INDEX 


0004 


ENTRY 


INDEX F( I, ICRTCL) 


0005 


ENTRY 


VINDEX F(I, ICRTCL, IJUMP ) 


0006 


ENTRY 


SETEST F(X,XNEW,XCRTCL) 


0007 


ENTRY 


SETAPT F t X ,XNEW, F VALUE ) 


0008 


ENTRY 


CHUSET F(X,X1,X2,ZIFX1) 


0009 






0010 






0011 




ABSTRACT 


0012 



» TITLE - INDEX, WITH SECONDARY ENTRIES V INDEX, SETEST, SETAPT* AND CHUSET 

* HYBRID SUBPROGRAMS FOR INCREMENTING, TESTING, AND SETTING 
* 

* THESE PROGRAMS ARE OPERATED AS FORTRAN- 1 1 FUNCTIONS BUT 

• ALSO MODIFY THE CONTENTS OF THE STORAGE LOCATION 

• CORRESPONDING TO THEIR FIRST ARGUMENT. THE FUNCTION 

♦ VALUES ARE DESIGNED FOR CONTROL APPLICATIONS IN IF 
» STATEMENTS. 



INDEX ADDS A FIXED POINT 
HA$ VALUE -1.0, 0.0, 1.0 
LSTHN, EQUAL TO, OR GRTHN 



1 TO ITS FIRST ARGUMENT AND 
ACCORDING AS THE SUM IS 
ITS SECOND ARGUMENT. 



VINDEX ADDS ITS THIRD ARGUMENT (FIXED POINT) TO ITS 
FIRST AND IS OTHERWISE THE SAME AS INDEX. 

SETEST SETS ITS FIRST ARGUMENT EQUAL ITS SECOND AND HAS 
VALUE -1.0, 0.0, 1.0 ACCORDING AS ITS SECOND ARGUMENT 
IS LSTHN, EQUAL TO, OR GRTHN ITS THIRD ARGUMENT, THE 
ARGUMENT MODES BEING ARBITRARY. 

SETAPT SETS ITS FIRST ARGUMENT EQUAL ITS SECOND, AND HAS 
VALUE EQUAL ITS THIRD ARGUMENT. 

CHUSET SETS ITS FIRST ARGUMENT EQUAL ITS SECOND (IF ITS 
FOURTH HAS ZERO MAGNITUDE) OR ITS THIRD (IF ITS FOURTH 
HAS NON-ZERO MAGNITUDE), AND HAS VALUE EQUAL ITS FOURTH 
ARGUMENT. 



THE COMPARISONS OF INDEX, VINDEX, 
PLUS AND MINUS ZERO AS EQUAL. 



AND SETEST TREAT 



» LANGUAGE 

• EQUIPMENT 

• STORAGE 

• SPEED 
» AUTHOR 



( FORTRAN-I I COMPATIBLE) 
(MAIN FRAME ONLY) 



FAP FUNCTIONS 
709,7090,7094 
50 REGISTERS 
ABOUT 70 MACHINE CYCLES 
S.M. SIMPSON, JUNE 1964 



• USAGE 

• NO TRANSFER VECTOR 
* 

» 

• FORTRAN USAGE OF INDEX FUNCTION 
» ANS = INDEXF(1,ICRTCL) 

* 

• INPUTS TO INDEX 
* 

• I AND ICRTCL ARE FIXED POINT. 
» 

• OUTPUTS FROM INDEX 

•I = 1+1 
• 

• ANS = -1.0, 0.0, +1.0 AS 1*1 LSTHN ICRTCL, 

• GRTHN ICRTCL. 



= ICRTCL 



0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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FORTRAN USAGE OF VINDEX FUNCTION 
ANS » VINDEXFU, ICRTCL, IJUMP) 

INPUTS TO VINDEX 

It ICRTCL, AND IJUMP ARE FIXED POINT, 
OUTPUTS FROM VINDEX 

I » I+IJUMP 

ANS = -1.0,0.0, + 1.0 AS I* I JUMP LSTHN ICRTCLI 

GRTHN ICRTCL. 



FORTRAN USAGE OF SETEST FUNCTION 
ANS * SETESTF(X, XNEW, XCRTCL) 

INPUTS TO SETEST 

X, XNEW, AND XCRTCL ARE ANY MODE. 
OUTPUTS FROM SETEST 

X » XNEW. 

ANS * -1.0, 0.0, +1.0 AS XNEW LSTHN XCRTCL* 

GRTHN XCRTCL. 



ICRTCL, 



* XCRTCL, 



» FORTRAN USAGE OF SETAPT FUNCTION 

* ANS = SETAPTF ( X, XNEW , F VALUE ) 
• 

* INPUTS TO SETAPT 
« 

* X, XNEW, AND FVALUE ARE ANY MODE. 
» OUTPUTS FROM SETAPT 



X 

ANS 



= XNEW 



FVALUE 



(POSSIBLY A MISNAMED FIXED POINT VALUE WHICH 
WILL NOT HURT IN IF STATEMENT APPLICATIONS* 
USE IANS = XSAMEF(SETAPTF(X,XNEW,IFVALU1I 
IF THIS IS TROUBLESOME.) 



# FORTRAN USAGE OF CHUSET FUNCTION 

* ANS = CHUSETFU, XI, X2, ZIFXl) 
• 

♦ INPUTS TO CHUSET 

♦ X, XI, X2, AND ZIFX1 ARE ANY MODE. 

* OUTPUTS FROM CHUSET 



X 

ANS 



* EXAMPLES 



* 1. INDEX 

• USAGE 



= XI IF MAGNITUDE OF ZIFXl IS ZERO, * X2 OTHERWISE* 
* ZIFXl (COMMENT ABOUT ANS UNDER SETAPT APPLIES). 



CARE MUST BE TAKEN IN THE USE OF INDEX AND VINDEX FOR 
SUBSCRIPTING PURPOSES AS ILLUSTRATED IN THE L09P PORTIONS 
OF EXAMPLES 1. AND 2. 



I = -2 

ANS 1 = INDEXF(I,0) 
ANS2 = INDEXF(I,0) 
ANS3 = INDEXF ( 1,0) 
J " 0 
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0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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• 10 J * J 0150 
» XU+l) * J 0151 

• I4F ( INDEXF< J, 10 ) ) 10,10,20 0152 

• 20 CONTINUE 0153 

• OUTPUTS - ANS1,2,3 * -1.0,0.0,1.0 I » 1 0154 
» XU...U) = 0.,1.,...,10. J = 11 0155 

• 0156 

• 2. VINOEX AND SETEST 0157 
» USAGE - K * 21 0158 

• 10 K = K 0159 
» Y(K) = K 0160 
» IF (VINDEXF(K,1,-1)> 20,10,10 0161 

• 20 ANSI = SETESTF(X1,1.0,2.0) 0162 

• ANS2 = SETESTF(X2,-0. 0,-0.0) 0163 

• ANS3 » SETESTF(X3,-0.0,0.0) 0164 

• ANS4 = SETESTF(X4,0. 0,-0.0) 0165 

• ANS5 * SETESTF(X5,0.0,0.0) 0166 

• ANS6 * SETESTF(X6,2.0,1.0) 0167 

• ANS7 » SETESTF(IX,2,1) 0168 
« OUTPUTS - Yd. ..21) * l.,2.,...,21. K = 0 0169 

• ANSI, 2, 3,4,5,6, 7 = -1.0,0.0,0.0,0.0,0.0,1.0,1.0 0170 

• XI, 2, 3, 4, 5, 6 * 1.0,-0.0,-0.0,0.0,0.0,2.0 IX » 2 0171 
» 0172 

• 3. SETAPT AND CHUSET 0173 

• USAGE - ANSI = SETAPTF(X,1.,2.) 0174 
» ANS2 » SETAPTFI IX, 7, 3.) 0175 

• ANS3 = CHUSETF(IY1,1,3,0.0) 0176 

• ANS4 * CHUSETF( IY2, 1,3,-2.0) 0177 
» ANS5 * CHUSETF(IY3,1,3,1.5) 0178 
» OUTPUTS - ANSI, 2, 3, 4, 5 - 2. , 3. ,0. ,-2., 1. 5 X » 1. IX * 7 0179 
» IY1,2,3 * 1,3,3 0180 

• 0181 

• 0182 

• 0183 

• PROGRAM FOLLOWS BELOW 0184 

• 0185 
» NO TRANSFER VECTOR 0186 

• 0187 
BCI 1, INDEX 0188 

» 0189 

• PRINCIPAL ENTRY. INDEXF ( I , ICRTCL ) 0190 
» 0191 

INDEX ADD KD1 I+l 0192 

SXD4 SXD ZFSACS,4 SWITCH SETTING FOR INDEX, VINDEX, 0193 

• AND SETEST 0194 
STQ CRTICL ICRTCL OR XCRTCL TO CRTICL 0195 
XCA 1*1, I+IJUMP, OR XNEW TO MQ 0196 
TRA SXA4 0197 

• 0198 

• SECOND ENTRY. V INDEXF ( I , ICRTCL , IJUMP ) 0199 
» 0200 
VINDEX ADD 32765 I+IJUMP 0201 

TRA SXD4 0202 

• 0203 

• THIRD ENTRY. SETESTF ( X ,XNEW , XCRTCL ) 0204 

• 0205 
SETEST XCA XNEW TO AC 0206 

LDQ 32765 XCRTCL TO MO 0207 

TRA SXD4 0208 

» 0209 

• FOURTH ENTRY. SETAPTF (X, XNEW, F VALUE ) 0210 
» 0211 
SETAPT CLA LDQX2 XNEW IN MQ IS OK, SET TO 0212 

TRA STACAC PICK UP FVALUE FROM 32765 0213 

• 0214 
» FIFTH ENTRY. CHUSETF(X,X1,X2,ZIFX1 ) 0215 
» 0216 
CHUSET ZET 32764 XI IN MQ OK IF ZIFX1 * 0 0217 

LDQX2 LDQ 32765 OTHERWISE X2 TO MQ 0218 

CLA CHUSET SET TO PICK UP ZIFX1 FROM 32764 0219 

STACAC STA CLAAC SET TERMINAL PICKUP FOR SETAPT, CHUSET 0220 

STZ ZFSACS SET SWITCH FOR SETAPT, CHUSET 0221 

• 0222 

• AT THIS POINT WE HAVE MQ * NEW VALUE, CRTICL = CRITICAL VALUE (FIRST 0223 
» 3 ENTRIES). BACK UP XR4 TILL -1,4 HAS STORAGE ADDRESS FOR NEW 0224 
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* VALUE (CLA I OR CLA X) 0225 

* 0226 
SXA4 SXA SV4,4 0227 
CAL CAL -1,4 0228 

ANA ATMASK KNOCK OUT ADDRESS AND TAG 0229 

LAS CLAZ 0230 

TXI CAL, 4,1 0231 

TRA GOTCLA 0232 

TXI CAL, 4,1 0233 

* 0234 

* THEN ANTICIPATE ENTRIES INDEX, V INDEX, SETEST, SET NEW VALUE, TEST, 0235 

* TREAT LAST 2 ENTRIES 0236 
» 0237 
GOTCLA CLS K1L (ANTICIPATE FOR NEW LSTHN CRTICL) 0238 

XCA 0239 

STO* -1,4 STORE NEW 0240 

SV4 AXT »»,4 ** = XR4 0241 

ZET ZFSACS 0242 

TRA NTSPCS 0243 

CLAAC CLA ** » 32765 FOR SETAPT, * 32764 FOR CHUSET 0244 

TRA 1,4 0245 

* 0246 

* COMPARE, FOR INDEX, VINDEX, SETEST, (NEW IN AC, -1.0 IN MQ) 0247 

* 0248 
NTSPCS TNZ CAS TEST 0249 

NZT CRTICL FOR 0250 

TRA LDQZ ZERO * ZERO 0251 

CAS CAS CRTICL 0252 

TRA GETK1 NEW GRTHN CRTICL 0253 

LDQZ LDQ KZ NEW EQUALS CRTICL 0254 

XCA NEW LSTHN CRTICL 0255 

TRA 1,4 0256 

GETK1 CLA K1L 0257 

TRA 1,4 0258 

* 0259 
» CONSTANTS, TEMPORARY 0260 

* 0261 
ATMASK OCT 777777000000 0262 

CLAZ CLA 0,0 0263 

KIL DEC 1.0 0264 

KD1 PZE 0,0,1 0265 

KZ PZE 0 0266 

CRTICL PZE »*,**,*» ICRTCL OR XCRTCL 0267 

ZFSACS PZE 0,0, »• •* =0 IF SETAPT OR CHUSET, *XR4 OTHERWISE 0268 

END 0269 
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* INTGRA (SUBROUTINE) 9/29/64 LAST CARO IN DECK IS NO. 0174 

* FAP 0001 
•INTGRA 0002 

COUNT 150 0003 

L8L INTGRA 0004 

ENTRY INTGRA (CIGRTN, YOFX, LY,DELX, YIGRTD, YOFXi) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - INTGRA 0009 

* INDEFINITE INTEGRAL BY TRAPEZOIDAL RULE 0010 

* 0011 

* INTGRA FORMS A VECTOR, YIGRTDU) 1=1.. .LY, REPRESENTING 0012 

* THE INTEGRAL OF ANOTHER VECTOR, YOFXU) 1=1. ..fcY* PLUS 0013 
» A GIVEN INTEGRATION CONSTANT, CIGRTN. THE INPUT VECTOR 0014 

* YOFX IS CONSIDERED TO REPRESENT EQUALLY SPACED ORDINATE 0015 

* VALUES OF A FUNCTION Y(X) AS FOLLOWS 0016 

* YOFXU) * Y(Xl) 0017 

* Y0FX(2) * Y(X2) WHERE X2 * Xl+DELX 0018 

* YOFXl 3) = Y(X3) WHERE X3 = X2+DELX 0019 

* ETC 0020 

* YOFX(LY) = Y(XN) WHERE XN * XN-l + DELX 0021 

* NOTE— DELX MAY BE NEGATIVE 0022 

* 0023 
» LET THE INTEGRAL TO BE COMPUTED BE REPRESENTED BY FIX) 0024 
» WITH 0025 
» X 0026 

* F(X) = C + INTEGRAL I Y(U) DU I 0027 
» U = XI 0028 

* 0029 
» % THEN THE OUTPUT VECTOR IS 0030 
» YIGRTDU) = F(X1) (THIS IS ALWAYS = C! 0031 
» YIGRTD( 2) = F(X2) 0032 

* ETC 0033 

* YIGRTD(LY) =F(XN) 0034 

* 0035 

* WHERE C = CIGRTN AND THE TRAPEZOIDAL APPROXIMATION IS 0036 

* USED FOR INTEGRATING. 0037 
« 0038 
« THE OUTPUT VECTOR MAY REPLACE THE INPUT VECTOR. 0039 

* 0040 

* INTGRA HAS ONE OTHER OUTPUT, Y0FX1, WHICH IS SET EQUAL 0041 

* TO THE VALUE OF YOFXU). USING THIS QUANTITY 0042 

* IT IS POSSIBLE TO INVERT EXACTLY THE INTEGRATED VECTOR, 0043 
» YIGRTD, AND REOBTAIN YOFX. THIS INVERSION IS PERFORMED 0044 
» BY SUBROUTINE IINTGR, WHOSE CALLING SEQUENCE IS THE 0045 

* REVERSE OF THAT OF INTGRA. 0046 

* 0047 
» LANGUAGE - FAP SUBROUTINE ( FORTRAN- I I COMPATIBLE) 0048 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0049 
» STORAGE - 47 REGISTERS 0050 
» SPEED - 7090 709 7090 709 0051 

* 141.2 OR 43.0) ♦ (37.8 OR 41.0)»LY MACHINE CYCLES 0052 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 0053 

* 0054 

* USAGE 0055 

* 0056 
» TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0057 
» AND FORTRAN SYSTEM ROUTINES - ( NONE) 0058 
» 0059 

* FORTRAN USAGE 0060 

* CALL INTGRA(CIGRTN, YOFX, LY,0ELX, YIGRTD, Y0FX1) 0061 

* 0062 

* INPUTS 0063 

* 0064 

* CIGRTN IS THE CONSTANT OF INTEGRATION 0065 
» 0066 
» YOFX(I) 1=1. ..LY IS THE VECTOR TO BE INTEGRATED 0067 
» 0068 

* LY SHOULD EXCEED 0 0069 

* 0070 

* DELX SHOULD BE NON-ZERO, MAY BE NEGATIVE 0071 

* 0072 
» OUTPUTS STRAIGHT RETURN WITH NO ACTION IF LY LSTHN 1 OR DELX « 0* 0073 
» 0074 
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• 




YIGRTDU) 


1=1. ..LY IS THE INTEGRATED VECTOR 


0075 


« 






YIGRTDU) » CIGRTN 


0076 


* 






YIGRTD(K) = YIGRTDi K-l) ♦ 


0077 


• 






DELXMYOFX(K) ♦ YQFX<K-1 ) 1 /2#0 


0078 


• 






FOR K=2,3,...,LY 


0079 


• 








0080 


• 






EQUIVALENCE (Y IGRTD,YOFX ) IS PERMITTED 


0081 


• 








0082 


» 




YOFXl 


IS SET EQUAL TO YOFX(l) 


0083 


• 








0084 


• 


EXAMPLES 




0085 


• 








0086 


• 


1. 


WITH VARIOUS VALUES OF DELX, CIGRTN AND LY 


0087 


» 




INPUTS - 


Y(1...7) 38 1*9 I.,..., 1. 


0088 


• 






Y11=Y12=...=Y18 * -999. YI7 * YI8 » -999. 


0089 


* 








0090 


• 




USAGE 


CALL INTGRAl 0., Y, 7, 1., YIl, Y1I) 


0091 


• 






CALL INTGRAC 0., Y, 7, 10., YI2, Y12) 


0092 


• 






CALL INTGRA( 0., Y, 7, -2., YI3, Y13) 


0093 


» 






CALL INTGRA( 1., Y, 7, 1., YI4, Y14) 


0094 


» 






CALL INTGRA( -1., Y, 2, 1., YI5, Y15I 


0095 


» 






CALL INTGRA( -1., Y, 1, 1., YI6, Y16) 


0096 


• 






CALL INTGRAt 0., Y, 0, 1., YI7, Y17) 


0097 


• 






CALL INTGRA( 0., Y, 7, 0., YI8, Y18) 


0098 


• 




OUTPUTS - 


YIK1.4.7) » 0., 1., 2.,..., 6. Yli * I. 


0099 


• 






YI2I1.4.7) » 0.,10.,20.,..., 60. Y12 * 1. 


0100 


» 






YI3<1.*.7) = 0.,-2.,-4.,...,-12. Y13 * 1. 


0101 


• 






YI4(l.i.7) = 1., 2., 3.,..., 7. Y14 * 1. 


0102 


* 






YI5U.4.2) = -1., 0. Y15 » 1. 


0103 


• 






YI6(1) = -1. Y16 = 1. 


0104 


• 






YI7 = Y17 = YI8 = Y18 = -999. (NO OUTPUT CASES) 


0105 


• 








0106 


• 


2. 


MULTIPLE 


INTEGRATION WITH OUTPUT REPLACING INPUT 


0107 


• 




INPUTS - 




0108 


* 




USAGE 


DO 10 1=1,3 


0109 


• 






10 CALL INTGRA(0.,Y,7,l.,Y,Y0FXl(I)) 


0110 


• 




OUTPUTS - 


Yd.. .7) = 0., l«, 6., 19., 44., 85., 146. 


0111 


• 






Y0FXK1...3) = 4., 0., 0. 


0112 


• 








0113 


• 


PROGRAM FOLLOWS BELOW 


0114 


« 








0115 


• 








0116 


* 


NO 


TRANSFER 


VECTOR 


0117 






HTR 


0 XR4 


0118 






BCI 


1, INTGRA 


0119 


» 


ONLY ENTRY. 


INTGRA ( CIGRTN, YOFX, LY, DELX, YIGRTD, YOFXl) 


0120 


INTGRA SXO 


INTGRA-2,4 


0121 


« 


CHECK LY (AT 


LEAST *1) AND DELX (NON-ZERO UNLESS LY«0) 


0122 






CLA» 


3,4 LY 


0123 






TMI 


LEAVE EXIT IF NEGATIVE, 


0124 






PDX 


0,4 


0125 






TXL 


LEAVE, 4,0 OR ZERO. 


0126 






SXD 


TXL, 4 STORED IF OK. 


0127 






TXL 


LXD4,4il AVOID DELX BUSINESS IF LY*1 


0128 






LXD 


INTGRA-2,4 


0129 






CLA» 


4,4 DELX 


0130 






TZE 


LEAVE 


0131 






FDP 


FL2 DELX /2.0 


0132 






STQ 


DX0V2 


0133 


» 


NOW SET OUTPUTS FOR LY AT LEAST =1 


0134 


LXD4 LXD 


INTGRA-2,4 


0135 






CLA» 


2,4 YOFX(l) 


0136 






STO 


LASTY 


0137 






STO» 


6,4 YOFXl 


0138 






CLA* 


1,4 CIGRTN 


0139 






STO* 


5,4 YIGRTD(l) 


0140 


• 


THEN SET UP 


LOOP FOR LARGER LY 


0141 






CLA 


2,4 


0142 






ADD 


Kl A(Y0FX)+1 


0143 






STA 


GET 


0144 






CLA 


5,4 


0145 






ADD 


Kl A(YIGRTD)+1 


0146 






STA 


STORE 


0147 






ADD 


Kl At YIGRTD)+2 


0148 






STA 


ADD 


0149 
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► BUT 1 


BYPASS 


THE LOOP IF LY 


= 1 




0150 




LXD 


TXL, 4 






0151 




TXL 


LEAVE, 4,1 






0152 


^ OTHERWISE 


ENTER LOOP 






0153 




A XT 


2,4 






0154 


> LOOP 


TO SET YIGRTO(2..,LY) 






0155 


GET 


LOQ 


*»,4 


*» =« A(YOFXm 




0156 




CLA 


LASTY 






0157 




STQ 


LASTY 






0158 




FAD 


LASTY 




YOFX(KUYOFXfK-l) 


0159 




XCA 








0160 




FMP 


DXOV2 




TIMES DELX/2.0 


0161 


AOO 


FAD 


♦ *,4 


##sA{ YIGRTD) +2 


PLUS YIGRTD(K-l) 


0162 


STORE 


STO 


**,4 


**=A<YIGRTDm 


BECOMES YI6RTD(K1 


0163 




TXI 


»+l,4,l 






0164 


TXL 


TXL 


GET,4,*» 


»*=LY 




0165 


> EXIT 










0166 


LEAVE 


LXD 


INTGRA-2,4 






0167 




TRA 


7,4 






0168 


► CONSTANTS, 


TEMPORARIES 






0169 


FL2 


DEC 


2.0 






0170 


Kl 


PZE 


1 






0171 


LASTY 


PZE 


**,»*,»* 


* PREVIOUS YOFX 


VALUES, STARTS WITH YOFXUI 


0172 


DXOV2 


PZE 


*•,**,*« 


* DELX/2.0 




0173 




END 








0174 
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* INTHOL {SUBROUTINE) 9/9/64 LAST CARD IN DECK IS NO. 0155 
» FAP 0001 
•INTHOL 0002 

COUNT 200 0003 

LBL INTHOL 0004 

ENTRY INTHOL (NHOL, HOL, FMT, NDATAD, NDATAA, DATA ) 0005 

» 0006 

* 0007 

* - ABSTRACT 0008 

* 0009 

* TITLE - INTHOL 0010 

* INTERPRET HOLLERITH 0011 
» 0012 
» SUBROUTINE INTHOL INTERPRETS A SERIES OF HOLLERITH WORDS 0013 
» ACCORDING TO A GIVEN FORMAT. 0014 
» 0015 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE! 0016 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0017 
« STORAGE - 72 REGISTERS 0018 

* SPEED - 0019 

* AUTHOR - R.A. WIGGINS 4/64 0020 
» 0021 
« 0022 

» USAGE 0023 

« 0024 

* TRANSFER VECTOR CONTAINS ROUTINES - FNDFMT 0025 
» AND FORTRAN SYSTEM ROUTINES - UOH),(RTN) 0026 

* 0027 
» FORTRAN USAGE 0028 
« CALL INTHOL (NHOL, HOL, FMT, NDATAD, NDATAA, DATA) 0029 
» 0030 
» 0031 

* INPUTS 0032 

* 0033 

* NHOL NUMBER OF HOLLERITH WORDS TO BE INTERPRETED 0034 

* MUST BE GRTHN= I, LSTHN= 22 0035 

* 0036 

* HOL(I) I=1,...,NH0L HOLLERITH WORDS (6 HOLLERITH CHARACTERS PER 0037 

* WORD) TO BE INTERPRETED. 0038 

* 0039 
» FMT(I) 1=1, 2,... IS EITHER A NORMAL FORMAT VECTOR* OR LITERAL 0040 
» HOLLERITH IN A CALLING SEQUENCE WHOSE CHARACTERS 0041 
» (READING LEFT TO RIGHT) ARE THE DESIRED FORMAT STRIPPED 0042 
» OF THE ENCLOSING PARENTHESES. THE FIRST AND SECOND 0043 

* CHARACTERS MUST NOT BE EITHER •(• OR •)• . 0044 

* IS USED TO INTERPRET HOL(I). 0045 
» SHOULD BE A FORMAT FOR READING ONLY ONE LINE, I.E. IT 0046 
» SHOULD CONTAIN NO •/• . 0047 

* 0048 

* NDATAD NUMBER OF DATA VALUES DESIRED FROM HOL ACCORDING TO FMT* 0049 

* SHOULD NOT PROVIDE FOR A GREATER NUMBER OF VALUES THAN 0050 

* CAN BE INTERPRETED. 0051 

* 0052 

* 0053 
» OUTPUTS 0054 

* 0055 

* NDATAA NUMBER OF DATA VALUES ACTUALLY INTERPRETED. INTHOL SCANS 0056 

* THE HOL AND FMT ONLY ONCE TO FIND THE DESIRED VALUES. 0057 

* 0058 

* DATA ( I ) 1=1,..., NDATAA CONTAINS THE VALUES INTERPRETED* 0059 

* 0060 
» 0061 

* EXAMPLES 0062 
» 0063 

* 1. INPUTS - NHOL = I HOL(i) = 6H-53.31 FMT ( 1 ) = 6H(F6.2) NDATAD* 1 0064 
» OUTPUTS - NDATAA = 1 DATA(l) = -53.31 0065 

* 0066 

* 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT NDATAD = 6 0067 

* OUTPUTS - SAME AS EXAMPLE 1. 0068 

* 0069 

* 3. INPUTS - NHOL = 2 H0LU...2) = 3HXYZ,6H 5 -9 NDATAD = 3 0070 
» USAGE - CALL INTHOL( NHOL , HOL, 6HA6,2I3 , NDATAD, NDATAA, 0071 

* 1 DATA) 0072 



••**••»•••••»*»•»*«**•*» 

♦ INTHOL * 
••»**•»*»•*•»*•»••**••»* 

(PAGE 2) 



PROGRAM LISTINGS 



#*•**»»»»»**•»**•*•»*•«• 

♦ INTHOL » 
*•*«*«*•*****»*+»*•***** 

(PAGE 2) 



OUTPUTS - NDATAA = 3 DATA! 1... 3) * 3HXYZ,5,-9 



» PROGRAM FOLLOWS BELOW 



* DUMMY READING SEQUENCE 



0073 
0074 
0075 
0076 
0077 



XPR1 


HPR 


0 






0078 


XPR2 


HPR 


0 






0079 


XPR4 


HPR 


0 






0080 




BCI 


I, INTHOL 






0081 


INTHOL 


SXD 


XPR4,4 




SAVE 


0082 




SXD 


XPR2,2 




INDEX 


0083 




SXD 


XPRl,l 




REGISTERS. 


0084 




AXT 


BUFSIZ,2 




PUT 


0085 




CLA 


=06060606 06060 


BLANKS 


0086 




STO 


-1,2 




IN 


0087 




TIX 


•-1 t2t 1 




BUFFER 


0088 




CAL 


2,4 




BEFORE 


0089 




ADD 


= 1835 






0090 




STA 


HOL 




TRANSFERRING 


0091 




CLA* 


1 1 4 




THE 


0092 




STD 


NHOL 






0093 




AXT 


1 , 1 




HOLLERITH 


0094 




AXT 


BUFSIZ,2 






0095 


HOL 


CLA 


**,1 




WORDS 


0096 




STO 


-1,2 




TO 


0097 




TIX 


*+2,2, 1 




THE 


0098 




TRA 


NHOL+l 




INPUT- 


0099 




TXI 


* + l ,1,1 




OUTPUT 


0100 


NHOL 


TXL 


HOL , 1 , ** 




BUFFER. 


0101 




CLA* 


4? 4 




SET UP 


0102 




STD 


NDATA 




INSTRUCT IONS 


0103 




CAL 


6,4 




FOR 


0104 




ADD 


= 1B35 




STORING 


0105 




STA 


DATA 




DATA. 


0106 




CLA 


3,4 




SET 


0107 




STA 


FMT1 




UP 


0108 




TSX 


$FNDFMTt4 




FNDFMT 


0109 


FMT1 


TSX 


**,0 




ARGUMENTS 


0110 




TSX 


INUM,0 






0111 




CLA 


=32562817 




CONVERT 


0112 




SUB 


INUM 




INDEX WITH RESPECT TO COMMON 


0113 




ARS 


18 




TO A 


0114 




STA 


FMT 




MACHINE ADDRESS. 


0115 




STZ 


IFST 




INITIALIZE ONE-PASS COUNTER. 


0116 




STZ 


INUM 




INITIALIZE DATA COUNTER. 


0117 


* 










0118 


» INITIALIZE 


( IOH) 






0119 


• 










0120 




CLA 


=2B17 




DUMMY ITAPE 


0121 




AXC 


FMT-1,4 




LOAD IR4 FOR DUMMY READING SEQUENCE 


0122 




LDQ 


NOP 




GET INPUT (SSH) FLAG 


0123 




TRA* 


$(IOH) 


* 


GO INITIALIZE (IOH) 


0124 


NOP 


NOP 


SSH 






0125 


* 










0126 


• RETURN FROM 


(IOH) - GO 


BACK 




0127 


• 










0128 


SSH 


ZET 


IFST 




IS THIS FIRST RETURN 


0129 




TRA 


RTN1 




NO, GO EXIT 


0130 




SXD 


IFST, 4 




YES, RESET IFST AND 


0131 




TRA 


1,4 


* 


RETURN TO (IOH) (BUFFER WAS SET UP AB0VE1 


0132 



0133 
0134 
0135 



FMT 


PZE 


** 


FORMAT ADDRESS 


0136 




AXT 


1,1 


SEQUENCE 


0137 


STR 


STR 




FOR 


0138 


DATA 


STQ 


**,1 


OBTAINING 


0139 




SXD 


INUM,1 


CONVERTED 


0140 




TXI 


*+l,l,l 


NUMBERS 


0141 


NDATA 


TXL 


STR,1,»* 


FROM 


0142 




TSX 


$( RTN) ,4 


( IOH). 


0143 


RTN1 


LXD 


XPR4,4 


RESTORE IR 4 


0144 




CLA 


INUM 


OUTPUT ACTUAL 


0145 




STO* 


5,4 


NO. OF DATA VALUES STORED. 


0146 


RTN 


LXD 


XPR1,1 


RESOTRE IR 1 


0147 
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LXD 


XPR2,2 


RESOTRE IR 2 


0148 




TRA 


7,4 


* RETURN TO MAIN. 


0149 


• 








0150 


IFST 


PZE 


0 


ONE-CARD SWITCH. 


0151 


INUM 


PZE 


0 


DATA COUNT. 


0152 


BUFSIZ 


EOU 


22 


BUFFER SIZE. 


0153 


• 


END 






0154 
0155 
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* INTOPR (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO. 025G 

* FAP OOOl 
•INTOPR 0002 

COUNT 200 0003 

L8L INTOPR 0004 

ENTRY INTOPR (NDATA, XLO, DELX, X, OPER) 0005 

* 0006 

* 0007 

* ABSTRACT 0008 

* 0009 
» TITLE - INTOPR 0010 

* INTERPOLATION OPERATOR FOR 1 TO 4 EVENLY SPACED DATA VALUES 0011 

* 0012 

* INTOPR FINOS 0PER(1,2,...,N) GIVEN N, X, XLO t DELX 0013 

* SUCH THAT FOR ANY N EQUALLY SPACED DATA VALUESt 0014 

* F(l)t F(2), FIN), WHERE N L STHN* 4, 0015 

* 0016 

* OPER(l)*F(l) + .. # ♦ OPER(N)»F(N) » P(X) 0017 
» 0018 

* WHERE P IS THE EXACT FITTING POLYNOMIAL <0F DEGREE 0019 
» N-l), TO THE DATA VALUES AS FOLLOWS. 0020 

* 0021 

* P(XLO) « F(l) 0022 
» P(XL0+DELX) = F(2) 0023 

* ETC. 0024 

* P{XL0+(N-1)»DELX) •» F ( N ) 0025 

* 0026 

* THE DEGENERATE CASE OF N * 1 YIELDS OPER(l) = 1.0 . 0027 

* 0028 

* 0029 
» LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0030 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0031 

* STORAGE - 111 REGISTERS 0032 

* SPEED - 50 MC FOR N=l WHERE MC = MACHINE CYCLES 0033 
» 90 MC FOR N=2 0034 

* 205 MC FOR N=3 0035 

* 435 MC (709) OR 380 MC (7090) FOR N*4 0036 
» AUTHOR - S.M. SIMPSON, MARCH 1964 0037 
» 0038 
» 0039 

* USAGE 0040 

» 0041 

* TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0042 

* AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0043 
» 0044 

* FORTRAN USAGE 0045 

* CALL I NTOPR ( NDATA* XLO, DELX, X, OPER) 0046 

* 0047 

* 0048 

* INPUTS 0049 

* 0050 

* NDATA IS THE QUANTITY N OF THE ABSTRACT 0051 

* MAY ONLY HAVE VALUE 1,2,3, OR 4 0052 
» 0053 

* XLO IS DEFINED IN ABSTRACT 0054 
» 0055 
» DELX IS DEFINED IN ABSTRACT 0056 

* MUST BE NON-ZERO (MAY BE NEGATIVE) 0057 

* 0058 

* X IS DEFINED IN ABSTRACT 0059 
» 0060 

* 0061 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUTS IF NDATA OR DELX ILLEGAL 0062 

* 0063 
» OPER(I) 1=1. ..NDATA IS THE OPERATOR AS DEFINED IN ABSTRACT 0064 
» 0065 

* 0066 
» EXAMPLES 0067 

* 0068 
» 1. THIS EXAMPLE FINDS THE OPERATORS FOR X VALUES CORRESPONDING 0069 
» EXACTLY TO THE DATA POINTS, IN WHICH CASE THE 0070 

* CORRESPONDING COEFFICIENT MUST BE UNITY AND THE OTHERS 0071 

* MUST VANISH. 0072 

* 0073 

* INPUTS - NDATA! ,NDATA2,NDATA3,NDATA4 * 1,2,3,4 XLO*0.0* DELX*2.0 0074 
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* USAGE - CAUL INTOPR( NOATA1 f XLO, DELX , O.O, OPER 11 ) 0075 

* CALL INT0PRINDATA2, XLO, DELX, 0.0,0PER21) 0076 

* CALL INTOPR( NDATA2, XLO, DELX , 2.0, 0PER22 ) 0077 

* CALL INT0PR(NDATA3, XLO, DELX, 0.0,OPER31) 0078 

* CALL INT0PR(NDATA3,XL0,DELX,2.0,0PER32) 0079 
» CALL INT0PR(NDATA3,XL0,DELX,4.0,0PER33) 0080 

* CALL INT0PR(NDATA4,XLO,DELX»0.0,OPER41) 0081 

* CALL INT0PR(NDATA4, XLO, D£LX,2.0» 0PER42) 0082 
» CALL INTOPR( NDAT A4, XLO, DELX, 4.0, 0PER43) 0083 

* CALL INT0PR(NDATA4, XLO, DELX, 6.0, 0PER44) 0084 

* OUTPUTS - OPERNM (N=1...4, M*1...N) IS A VECTOR OF LENGTH N, 0085 

* ALL OF WHOSE ELEMENTS VANISH EXCEPT OP£RNM(MI = 1*0 • 0086 

* 0087 

* 2. NON-TRIVIAL EXAMPLES 0088 

* INPUTS - SAME AS EXAMPLE 1. EXCEPT OELX = 1.0 0089 

* USAGE - CALL INTOPR( NDAT A2» XLO, DELX, 0.5, 0PER23) 0090 

* CALL INT0PR(NDATA3,XL0,DELX,0.5,0PER34) 0091 

* CALL INT0PRlNDATA4,XL0t DELX, 0. 5,0PER45) 0092 
» OUTPUTS - OPER23U...23 = 0.5,0.5 0093 
» 0PER34(1...3> = 0.375,0.750,-0,125 0094 

* 0PER45U...4) = 0.3125,0.9375,-0.3125,0.0625 0095 
» 0096 

* 3. ERROR EXITS 0097 

* INPUTS - SAME AS EXAMPLE 1., EXCEPT SET 0PER(1...4l * -9999. 0098 

* USAGE - CALL INTOPR(0 , XLO, DELX , 1 . , OPER ) 0099 

* CALL INT0PR(5, XLO, DELX, 1., OPER) 0100 
» CALL INT0PR(NDATA2, XLO, 0. , 1., OPER) 0101 

* OUTPUTS - 0PERU...4) » -9999. 0102 
» 0103 
» 0104 
» PROGRAM FOLLOWS BELOW 0105 

* 0106 



♦ NO TRANSFER 

* ONLY ENTRY. 
* 

HTR 
HTR 
BCI 

•ONLY ENTRY. 
• 

INTOPR SXD 
SXD 
NZT* 
TRA 
CLA» 
TMI 
PDX 
TXL 
TXH 
CLA 
AOO 
STA 
CLA 
LOQ 
TXH 
CLA 
LDQ 
TXH 
TXL 

» 

» N0ATA=2 
» 

CLA» 

FSB* 

FOP» 

STQ 

CLA 

FSB 

STO 

TRA 

• 

» COMPUTE Y s 



VECTOR 0108 

0109 

I NTOPR ( NDAT A, XLO, DELX, X, OPER) 0110 

0111 

0 XR1 0112 

0 XR4 0113 

1, INTOPR 0114 

0115 

INTOPR (NDATA, XLO, DELX, X, OPER) 0116 

0117 

INTOPR-2,4 0118 
INTOPR-3,1 0119 
3,4 DELX ZERO CHECK 0120 

LEAVE 0121 
1,4 NDATA CHECK 0122 

LEAVE 0123 
0,1 (STAYS IN XR1 TILL WINDUP) 0124 

LEAVE, 1,0 0125 
LEAVE, 1,4 0126 
5,4 A(OPER) 0127 

KA1 0128 
STOOPR 0129 
K2L (B) ANTICIPATE NDATA=4 0130 

K3L (A) 0131 

F0RMY,1,3 AND TEST FOR IT 0132 

K1L (B OR Kl) IF NOT, ANTICIPATE NDATA *3i OR 1 0133 

K1L (A) 0134 

F0RMY,1,2 AND TEST FOR IT 0135 

STOOPR, 1,1 (IT MIGHT BE 2, IT MIGHT BE 1) 0136 

0137 
0138 
0139 

4,4 0140 
2,4 0141 
3,4 0142 
K2 K2 » (X-XLO)ZDELX 0143 

K1L 0144 
K2 0145 
Kl Kl = 1-K2 0146 

WINDUP 0147 

0148 

NORMALIZED X, FOR NDATA = 3, 4 0149 



• INTOPR 
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> (A IS 


IN MQ V B 


IN AC) 


0150 


► AND THEN BRANCH ON 


NDATA 


AGAIN 


0151 










0152 


ORMY STQ 


K4 




(K4 IS TEMP HERE, FOR A) 


0153 


FOP» 


3,4 






0154 


STQ 


K3 




(K3 IS TEMP HERE, FOR B/DELXI 


0155 


CLA» 


4,4 




X 


0156 


FSB* 


2,4 




-XLO 


0157 


XCA 








0158 


FMP 


K3 




•B/DELX 


0159 


FSB 


K4 




-A 


0160 


STO 


Y 




Y « (X-XLO) *B/DELX - A 


0161 


XCA 








0162 


FMP 


Y 






0163 


STO 


K4 




(Y-SQUARED WILL BE USEFUL) 


0164 


TXH 

h 


NDEQ4, 


1*3 




0165 
0166 


► RETURN TO 


THE CASE 


NDATA* 


3 AND SET Kl,K2tK3 


0167 


► (REMEMBER K4 AND AC 


HAVE Y-SQUARED) 


0168 










0169 


FSB 


Y 






0170 


FDP 


K2L 






0171 


STQ 


Kl 




Kl*( YSQR-Y)/2.0 


0172 


CLA 


K1L 






0173 


FSB 


K4 






0174 


STO 


K2 




K2*< 1-YSQR) 


0175 


CLA 


K4 






0176 


FAD 


Y 






0177 


FDP 


K2L 






0178 


STQ 


K3 




K3»(YSQR+Y)/2.0 


0179 


TRA 


WINDUP 






0180 
0181 


> SET K1,K2, 


K3,K4 FOR 


NDATA=4 


0182 










0183 


NDEQ4 CLS 


Y 






0184 


FAD 


K3L 






0185 


XCA 








0186 


FMP 


Y 






0187 


FAD 


KIL 






0188 


XCA 








0189 


FMP 


Y 






0190 


FSB 


K3L 






0191 


FDP 


K48L 






0192 


STQ 


Kl 




Kl=( ((-Y+3)Y+l)Y-3)/48 


0193 


CLA 


Y 






0194 


FSB 


KIL 






0195 


XCA 








0196 


FMP 


Y 






0197 


FSB 


K9L 






0198 


XCA 








0199 


FMP 


Y 






0200 


FAD 


K9L 






0201 


FDP 


K16L 






0202 


STQ 


K2 




K2*( (<Y-l)Y-9)Y+9)/16 


0203 


CLS 


Y 






0204 


FSB 


KIL 






0205 


XCA 








0206 


FMP 


Y 






0207 


FAD 


K9L 






0208 


XCA 








0209 


FMP 


Y 






0210 


FAD 


K9L 






021 1 


FDP 


K16L 






0212 


STQ 


K3 




K3=( ( (-Y-1)Y+9)Y*9)/16 


021 3 


CLA 


Y 






0214 


FAD 


K3L 






0215 


XCA 








0216 


FMP 


Y 






0217 


FSB 


KIL 






0218 


XCA 








0219 


FMP 


Y 






0220 


FSB 


K3L 






0221 


FDP 


K48L 






0222 


STQ 


K4 




K4^( ( (Y+3)Y-l)Y-3)/48 


0223 



0224 
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* MOVE K1,K2,... TO OPER( 1...NDATA) 0225 
« 0226 
WINDUP CIA Kl+1,1 0227 
STOOPR STO • *,! »*=A(0PER)+1 0228 

TIX WINDUP,l,l 0229 

» 0230 

* EXIT 0231 

* 0232 
LEAVE LXD INTOPR-3,1 0233 

TRA 6,4 0234 

* 0235 

* CONSTANTS, TEMPORARIES 0236 

* 0237 
KA1 PZE 1 0238 
KIL DEC 1,0 0239 
K2L DEC 2.0 0240 
K3L DEC 3.0 0241 
K9L DEC 9.0 0242 
K16L DEC 16.0 0243 
K48L DEC 48.0 0244 
K4 PZE #*,**,*♦ 0245 
K3 PZE #♦,*♦,*♦ 0246 
K2 PZE **,*»,»* 0247 
Kl PZE **,#»,*« 0248 
Y PZE *#,*#,#* 0249 

END 0250 



•••••»•*••••*•«•••*•••«* PROGRAM LISTINGS #«»*»♦**»***«#»***#»«#•» 

» INTSUM » » INTSUM • 

***•••*•••••«**»»«••«••• #»*•*• **•*•*•#••** *»»*»» 

• INTSUM (SUBROUTINE) 9/29/64 LAST CARO IN DECK IS NO. 0109 

* FAP 0001 
•INTSUM 0002 

COUNT 100 0003 

LBL INTSUM 0004 

ENTRY INTSUM ( X, LX,XISUMD) 0005 

ENTRY XNTSUM < I X , L IX , IX I SMD) 0006 

* 0007 
» ABSTRACT 0008 

* 0009 

• TITLE - INTSUM 0010 

• INTEGRATED SUMMATION OF A FLOATING OR FIXED VECTOR 0011 

* 0012 
» INTSUM FORMS A FLOATING VECTOR WHOSE I-TH ELEMENT IS THE 0013 
« SUM t THROUGH ELEMENT I, OF THE ELEMENTS OF ANOTHER 0014 

• FLOATING VECTOR. OUTPUT MAY REPLACE INPUTi 0015 
« 0016 

* XNTSUM DOES THE SAME THING FOR FIXED VECTORS. 0017 
» 0018 
» INTSUM AND XNTSUM ARE THE EXACT INVERSE OPERATORS OF 0019 
» SUBROUTINES OIFPRS AND XDFPRS RESPECTIVELY. 0020 

* 0021 

* LANGUAGE - FAP SUBROUTINES ( FORT RAN- I I COMPATIBLE) 0022 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0023 

• STORAGE - 27 REGISTERS 0024 

• SPEED - INTSUM 35 + 12.4»LX MACHINE CYCLES, LX= VECTOR LENGTH 0025 

• XNTSUM 37 + 8.0*LX 0026 
» AUTHOR - S.M. SIMPSON, AUGUST 1963 0027 

* 0028 

• USAGE 0029 

• 0030 

* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0031 

• AND FORTRAN SYSTEM ROUTINES - (NONE) 0032 
» 0033 
» FORTRAN USAGE 0034 

• CALL INTSUM! X, LX,XISUMD) 0035 
» CALL XNTSUM(IX,LIX,IXISMD) 0036 

* 0037 

• INPUTS 0038 
» 0039 

• X(I) 1=1. ..LX IS A FLOATING VECTOR INPUT TO INTSUM 0040 

• LX SHOULD EXCEED ZERO 0041 

* 0042 

* IX(I) 1=1. ..LIX IS A FXD VECTOR INPUT TO XNTSUM. THE POSITION 0043 

* OF THE BINARY POINT IS ARBITRARY. 0044 
» LIX SHOULD EXCEED ZERO 0045 

• 0046 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LX OR LIX LSTHN 1 0047 
» 0048 
» XISUMD(I) 1*1. ..LX IS XISUMD(I) = SUM(FROM K=l TO I) OF X(KI 0049 

# 0050 

* IXISMD(I) 1=1. ..LIX IS IXISMD(I) * SUM( FROM K*l TO I) OF IX(Ki, 0051 

* WITH SAME BINARY POINT AS IX. 0052 

* DANGER OF FIXED POINT OVERFLOW NOT TESTED FOR BY XNTSUM* 0053 
« 0054 

♦ EQUIVALENCE(XISUMD,X),(IXISMD,IX) IS PERMITTED 0055 

• 0056 

* EXAMPLES 0057 

♦ 0058 

• I. INPUTS - XU...4) = 1., 2., 3., 4. IXU...4) = 1,2,3,4 SUM3 =04 0059 

• USAGE - CALL INTSUM( X,4, SUM1) 0060 
» CALL XNTSUM(IX,4,ISUM1) 0061 

• CALL INTSUM( X,4, X) 0062 
» CALL INTSUM( X,l, SUM2) 0063 

* CALL INTSUM( X,0, SUM3) 0064 

♦ OUTPUTS - SUMM1...4) = 1., 3., 6., 10. ISUMKU..4) = 1,3,6,10 0065 

* X(1...4) = 1., 3., 6., 10. SUM2 * 1. 0066 

• SUM3 =0. (NO OUTPUT CASE) 0067 

* 0068 
» 2. INPUTS - IXU...3) = OCT 000000000001, 000000000002, 000000000003 0069 

* USAGE - CALL XNTSUM ( I X, 3, IX ) 0070 
» OUTPUTS - IX(1..*3) = OCT 000000000001, 000000000003, 000000000006 0071 

* 0072 
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* PROGRAM FOLLOWS BELOW 0073 



ft 








0074 


ft 








0075 


♦ NO TRANSFER 


VECTOR 




0076 




HTR 


0 


XR4 


0077 




BCI 


1, INTSUM 




0078 


* PRINCIPAL ENTRY. I NTSUM ( X , LX, X I SUMD ) 


0079 


INTSUM 


CLA 


FAD 




0080 


SETUP 


STO 


GET 




0081 




SXD 


INTSUM-2,4 




0082 




CLA 


1,4 


A(X) 


0083 




STA 


GET 




0084 




CLA 


3,4 


A(XISUMD) 


0085 




STA 


STORE 




0086 




CLA« 


2,4 


LX 


0087 




TMI 


LEAVE 




0088 




PDX 


0,4 




0089 




TXL 


LEAVE, 4,0 




0090 




TXI 


•♦1,4,-1 


LX-1 


0091 




SXD 


TXL, 4 




0092 




PXD 


0,0 


CLEAR AC 


0093 




PDX 


0,4 


AND XR4 


0094 


* LOOP 








0095 


GET 


NOP 




FAD **,4 OR ADD ft*,4 ft**A(X> 


0096 


STORE 


STO 


**,4 


**=A(XISUMD) 


0097 




TXI 


♦♦1,4,1 




0098 


TXL 


TXL 


GET ,4, *♦ 


»*=LX-1 


0099 


* EXIT 








0100 


LEAVE 


LXD 


INTSUM-2,4 




0101 




TRA 


4,4 




0102 


* SECOND ENTRY. XNTSUM (IX, 


LIX, IXISMD) 


0103 


XNTSUM 


CLA 


ADD 




0104 




TRA 


SETUP 




0105 


* CONSTANTS 






0106 


FAD 


FAD 


**,4 




0107 


ADD 


ADD 


** ,4 




0108 




END 






0109 



» IPLYEV 



PROGRAM LISTINGS 



IPLYEV 



» IPLYEV (SUBROUTINE) 10/2/64 LAST CARD IN DECK IS NO* 0083 

• LABEL 0001 

CIPLYEV 0002 

SUBROUTINE I PL YE V ( LA, A, X, Y» EVR, EV I ) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - IPLYEV 0007 

C COMPLEX POLYNOMIAL EVALUATION 0008 

C 0009 

C IPLYEV EVALUATES THE POLYNOMIAL WITH REAL COEFFICIENTS 0010 

C 0011 

C EV = A(1)*A(2)*Z+A(3)»Z*«2+....A(LA)»Z*»(LA-1) 0012 

C 0013 

C AT THE POINT Z = X + IY. 0014 

C 0015 

C IF X=COS(W) AND Y=SIN(W) FOR REAL W THEN THIS POLYNOMIAL 0016 

C EVALUATION IS EQUIVALENT TO TAKING THE FOURIER TRANSFORM 0017 

C OF A(I),I=l..„LA AT THE FREQUENCY W. (W»PI IS THE 0018 

C FOLDING FREQUENCY). 0019 

C 0020 

C LANGUAGE - FORTRAN II SUBROUTINE (USES COMPLEX ARITHMETIC) 0021 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0022 

C STORAGE - 98 REGISTERS 0023 

C SPEED - ABOUT 126*LA ♦ 86 MACHINE CYCLES ON THE 7090. 0024 

C AUTHOR - R. A. WIGGINS, 9/26/62 0025 

C 0026 

C USAGE 0027 

C 0028 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0029 

C AND FORTRAN SYSTEM ROUTINES - (IFMP) 0030 

C 0031 

C FORTRAN USAGE 0032 

C CALL IPLYEV(LA,A,X,Y,EVR,EVI) 0033 

C 0034 

C INPUTS 0035 

C 0036 

C A(I) 1=1. ..LA ARE THE FLOATING POINT COEFFICIENTS OF THE 0037 

C POLYNOMIAL 0038 

C 0039 

C LA IS FORTRAN II INTEGER 0040 

C MUST BE GRTHN- 2 0041 

C 0042 

C X IS THE REAL PART OF THE NUMBER AT WHICH THE POLYNOMIAL 0043 

C IS TO BE EVALUATED. 0044 

C 0045 

C Y IS THE IMAGINARY PART OF THE NUMBER AT WHICH THE 0046 

C POLYNOMIAL IS TO BE EVALUATED. 0047 

C 0048 

C OUTPUTS 0049 

C 0050 

C EVR IS THE REAL PART OF THE POLYNOMIAL EVALUATION. 0051 

C 0052 

C EVI IS THE COMPLEX PART OF THE POLYNOMIAL EVALUATION. 0053 

C 0054 

C EXAMPLES 0055 

C 0056 

C 1. INPUTS - A(1...3)=3.t2.,l. LA=3 X=l. Y=0. 0057 

C OUTPUTS - EVR=6. EVI=0. 0058 

C 0059 

C 2. INPUTS - A(1...3)*3*,2.,l. LA=3 X=0. Y=i. 0060 

C OUTPUTS - EVR=2. EVI=2. 0061 

C 0062 

C 3. INPUTS - A(1...3)=3.,2.t I. LA=3 X*l. Y = l. 0063 

C OUTPUTS - EVR=5. EVI=4. 0064 

C 0065 

I DIMENSION Z(1),A1(1),EV(1) 0066 

DIMENSION A(5) 0067 

Z(1)=X 0068 

Z(2)=Y 0069 

Al(2)=0. 0070 

EV ( 1 ) =A( LA) 0071 

EV(2)=0. 0072 

C«*»«* 0073 

DO 10 1=2, LA 0074 
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J=LA-I 

Ai(l)=A< J+l) 
I EV=A1+EV»Z 
10 CONTINUE 

EVR^EVU) 
EVI*EV(2> 
RETURN 
END 



* IPLYEV • 
«•»*••••»••*•••••••••••« 
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0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 



• ITOMLI 



PROGRAM LISTINGS 



# ITOMLI * 
#•»**•••*••*•**•*•**•«»» 



ITOMLI i SUBROUTINE ) 
FAP 



9/29/64 LAST CARD IN OECK IS NO* 



•ITOMLI 



COUNT 100 
LBL ITpMLI 

ENTRY ITOMLI « I V, LIV f ML IV, I ANS I 

• 

« — — ABSTRACT 

* 

» TITLE - ITOMLI 

» FAST CONVERT FORTRAN INTEGER VECTOR TO ML I VECTOR 

• 

» ITOMLI CONVERTS A FORTRAN INTEGER VECTOR TO A MACHINE 

» LANGUAGE INTEGER VECTOR* 

• 

• LANGUAGE - FAP SUBROUTINE ( FORTRAN II COMPATIBLE! 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 

• STORAGE - 37 REGISTERS 

• SPEED - LENGTH OF VECTOR TIMES 8 MACHINE CYCLES 
» AUTHOR - S.M. SIMPSON JR, MAY 1961 

* 

* USAGE 

» 

» TRANSFER VECTOR CONTAINS ROUTINES - NONE 

* AND FORTRAN SYSTEM ROUTINES - NONE 
• 

• FORTRAN USAGE 

» CALL ITOMLIUV, LIV, MLIV, IANS) 

» 

* INPUTS 
# 

• IVU) 
* 

* LIV 

» OUTPUTS 

• MLIVII) 
» 

* IANS 
» 

» EXAMPLES 
» 

» 1* INPUTS 

♦ OUTPUTS 



1=1 ,2,. • • ,LI V IS THE FORTRAN FIXED POINT VECTOR. 
MUST EXCEED 0 



1 = 1 * 2, . »LI V IS THE MACHINE LANGUAGE FIXED POINT VECTOR. 
MLIV MAY BE SET EQUIVALENT TO IV. 



« 0 JOB DONE OK 

LIV IS ILLEGAL 



I V* I, -1,2, -2, 10,-10 LIV=6 

ML I V=OCT 1 , 40000000000 1,2, 400000000002, 12, 400000000012 
IANS'O 



» 2. INPUTS 
» OUTPUTS 



» 3. INPUTS 
• OUTPUTS 



SAME AS EXAMPLE 1. 
IANS=-1 



EXCEPT LIV=0 



IVU) = 3 
IANS=0 



LIV^l 

MLIV( 1)=QCT3 



HTR 


0 




BCI 


1, ITOMLI 




ITOMLI SXA 


EXIT,i 




SXD 


ITOMLI-2,4 




CLA 


1,4 


A(AUV)) 


ADD 


Kl 




STA 


CLA 




CLA 


2,4 


A(A(LIV>) 


STA 


GET 2 




CLA 


3,4 


A(A(MLIV) ) 


ADD 


Kl 




STA 


STO 




CLA 


4,4 


A(A( IANS) ) 


STA 


PUT4 




* GET AND CHECK LIV. 




CLS 


Kl 




STO 


IANS 




GET2 CLA 




A(LIV) 


ARS 


18 




STO 


LIV 





0097 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 



*••••*•«»•**•*»••*•*»*«» PROGRAM LISTINGS #»♦###♦#*»»•»**♦##»♦***» 

» ITOMLI * « ITOMtl » 

**•»•*•»•*»*•*«**«**•**» #•#••»•»»#***#•**••»#*•• 

(PAGE 2) (PAGE 2) 



TMI 


LEAVE 




0075 


TIE 


LEAVE 




0076 


LOOP 






0077 


CLA 


KO 




0078 


STO 


IANS 




0079 


LXA 


LIV,1 




0080 


CLA CLA 


**t 1 


A( IV) + 1 


0081 


ARS 


18 




0082 


STO STO 


»*,1 


A(MLIV)+1 


0083 


TIX 


CLA f 1,1 




0084 


STORE IANS 


AND EXIT. 




0085 


LEAVE CLA 


IANS 




0086 


ALS 


18 




0087 


PUT4 STO 


*» 


A( IANS) 


0088 


EXIT AXT 






0089 


TRA 


5,4 




0090 


CONSTANTS 






0091 


KO PZE 


0 




0092 


Kl PZE 


1 




0093 


VARIABLES 






0094 


IANS PZE 


*• 




0095 


LIV PZE 


#* 




0096 


END 






0097 



»••••*••••••»••«••*• PROGRAM LISTINGS »»•»»•»***»« 

IVTOHV • • IVTOHV 



* IVTOHV ( SUBROUTINE ) 3/15/65 LAST CARD IN DECK IS NO. 0147 
« FAP 0001 
•IVTOHV 0002 

COUNT 150 0003 

LBL IVTOHV 0004 

ENTRY IVTOHV (IV,LHV,HV) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - IVTOHV 0009 
« PACK UP FORTRAN INTEGER VECTOR AS HOLLERITH VECTOR 0010 

* 0011 

* IVTOHV CONVERTS AN INTEGER VECTOR IVU), I=1...6»LHV, 0012 

* INTO A PACKED VECTOR HVU), 1*1. ..LHV. THE BITS 12 THRU 0013 

* 17 OF EACH IVU) ARE EXTRACTED (OTHER BITS ARE IGNORED). 0014 
« 6 GROUPS LIKE THIS FROM 6 SUCCESSIVE IVU) REGISTERS 0015 

* ARE PACKED INTO A SINGLE HVCI) WORO. 0016 
» 0017 

* IVTOHV IS THE INVERSE OF SUBROUTINE HVTOIV 0018 
« 0019 
« LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0020 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0021 

* STORAGE - 70 REGISTERS 0022 

* SPEED - 59 ♦ 67«LHV MACHINE CYCLES 0023 

* AUTHOR - S.M. SIMPSON, MARCH, 1963 0024 
» 0025 

* USAGE 0026 

* 0027 
» TRANSFER VECTOR CONTAINS ROUTINES - NONE 0028 

* AND FORTRAN SYSTEM ROUTINES - NONE 0029 

* 0030 
« FORTRAN USAGE 0031 
« CALL IVTOHV(IV,LHV,HV) 0032 

* 0033 

* INPUTS 0034 
« 0035 
« IVU) I=1...6*LHV IS AN ARBITRARY INTEGER VECTOR 0036 
« (ONLY BITS 12, ...,17 ARE VISIBLE TO IVTOHV, I.E. 0037 
« POSITIVE FORTRAN INTEGERS LESS THAN* 63) 0038 

* 0039 
« LHV IS THE LENGTH OF THE OUTPUT HOLLERITH VECTOR 0040 
» MUST EXCEEO ZERO (STRAIGHT RETURN IF NOT) 0041 
« 0042 
« OUTPUTS (IVTOHV TURNS OFF THE AC OVERFLOW INDICATOR) 0043 
» 0044 
» HV(I) 1=1. ..LHV IS THE PACKED HOLLERITH 0045 

* E.G. HVU) CONTAINS IVU. ..6) PACKEO 0046 

* HV<2) CONTAINS IV(7...12) PACKED 0047 
» ETC 0048 

* PACKING IS LEFT-TO-RIGHT (IVU) OCCUPIES BITS 0...5) 0049 
« EQUIVALENCE ( IV, HV) IS PERMITTED 0050 

* 0051 
« EXAMPLES 0052 

* 0053 

* 1. INPUTS - IVU. ..18) » 19,24,17,41,17,19,51,21,41,50, 0054 

* 48,51,38,48,39,17,19,34 LHV * 3 0055 

* OUTPUTS - HVU) = 6HCHARAC ( = 0CT233021512123 ) 0056 

* HV(2) * 6HTERS T (= OCT632551626063 ) 0057 

* HV(3) = 6H0 PACK ( = 0CT466047212342 ) 0058 

* 0059 

* 2. SHOWING MASKING BEHAVIOUR AND ILLEGAL LHV BEHAVIOUR 0060 

* INPUTS - IVU. ..6) » -17,82,83,84,-85,22 0061 

* (IE IV(1...6)*OCT400021000000, 000122000000, 000123000000, 0062 
« 000124000000,400125000000,000026000000 ) 0063 
« USAGE - DIMENSION HV(2), IV(6) 0064 

* CALL IVTOHV( IV,1,HV) 0065 
« CALL IVT0HV(IV,0,HV(2)) 0066 
« OUTPUTS - HVU) * 6HABCDEF (= 0CT212223242526 ) 0067 
« HV(2) IS UNOI STURBED 0068 
« 0069 

* PROGRAM FOLLOWS BELOW 0070 

HTR 0 0071 

HTR 0 0072 

HTR 0 0073 

BCI 1, IVTOHV 0074 



IVTOHV 



PROGRAM LISTINGS 



IVTOHV 



C PAGE 2) C PAGE 



IVTOHV 


SXD 


IVTOHV 


-2, 


4 




0075 




SXO 


IVTOHV 


-3, 


2 




0076 




SXD 


IVTOHV 


-4, 


1 




0077 


* SETUP SEQUENCE 








0078 




CLA 


1,4 






A(IV) 


0079 




STA 


CI 








0080 




SUB 


Kl 








0081 




STA 


C2 








0082 




SUB 


Kl 








0083 




STA 


C3 








0084 




SUB 


Kl 








0085 




STA 


C4 








0086 




SUB 


Kl 








0087 




STA 


C5 








0088 




SUB 


Kl 








0089 




STA 


C6 








0090 




CLA» 


2,4 






LHV 


0091 




TMI 


LEAVE 








0092 




TZE 


LEAVE 








0093 




STO 


TESTLH 








0094 




CLA 


3,4 






A<HV) 


0095 




ADO 


Kl 








0096 




STA 


SLW 








0097 


» (XR2) CONTROLS ACQUISITION 


, XR1 CONTROLS STORAGE) 


0098 




AXT 


0,2 








0099 




AXT 


1,1 








0100 


« LOOP 


(STRAIGHT LINE 


PROGRAM FOR SPEED) 


0101 




LOQ 


KO 






(MUST BE ZERO FOR SHIFTS) 


0102 


NEXT6 


STZ 


WORO 








0103 


CI 


CLA 


««,2 






•*=A(IV) 


0104 




ANA 


MSK 








0105 




LGL 


12 








0106 




ACL 


WORO 








0107 




SLW 


WORO 








0108 


C2 


CLA 


»»»2 






»»*A(IV)-l 


0109 




ANA 


MSK 








0110 




LGL 


6 








0111 




ACL 


WORO 








0112 




SLW 


WORO 








0113 


C3 


CLA 


»*,2 






♦•*AUV)-2 


0114 




ANA 


MSK 








0115 




ACL 


WORD 








0116 




SLW 


WORO 








0117 


C4 


CLA 


• *,2 






•♦*AUV)-3 


0118 




ANA 


MSK 








0119 




ARS 


6 








0120 




ACL 


WORD 








0121 




SLW 


WORD 








0122 


C5 


CLA 


»*,2 






*»=A(IV)-4 


0123 




ANA 


MSK 








0124 




ARS 


12 








0125 




ACL 


WORD 








0126 




SLW 


WORD 








0127 


C6 


CLA 


••,2 






»«=A(IV)-5 


0128 




ANA 


MSK 








0129 




ARS 


18 








0130 




ACL 


WORD 








0131 


SLW 


SLW 


•*,1 






»«*A(HV)+1 


0132 


* BUMP 


XRS 


AND CHECK 


COMPLETION 


0133 




TXI 


•♦1,2, 


6 






0134 




TXI 


•♦Itlt 


1 






0135 


TESTLH 


TXL 


NEXT6, 


!#*• 


•»*LHV 


0136 




TOV 


LEAVE 






(Cl*2 MAY CAUSE OVERFLOW) 


0137 


* EXIT 












0138 


LEAVE 


LXO 


IVTOHV 


-3, 


2 




0139 




LXD 


IVTOHV 


-4, 


1 




0140 




TRA 


4,4 








0141 


* CONSTANTS 


, TEMPORARIES 




0142 


KO 


PZE 


0 








0143 


Kl 


PZE 


1 








0144 


MSK 


OCT 


000077000000 




0145 


WORD 


PZE 


•• 








0146 




END 










0147 



» IXCARG « 
**«**»*«•»••«»«»•*•»•*«* 



PROGRAM LISTINGS 



*••*«**«•««•*#«•**••»•** 
# IXCARG • 
«•#«***«**•**•«***•••••• 



* IXCARG I SUBROUT 1NE ) 9/29/64 LAST CARD IN DECK IS NO. 0066 

* LABEL 0001 
C IXCARG 0002 

SUBROUTINE IXCARGt ARG, IXCOM) 0003 

C 0004 

C ABSTRACT- 0005 

C 0006 

C TITLE - IXCARG 0007 

C LOCATE ARGUMENT WITH RESPECT TO COMMON 0008 

C 0009 

C IXCARG RETURNS THE LOCATION OF ITS FIRST ARGUMENT TO OOiO 

C THE CALLING PROGRAM, THE LOCATION BEING DETERMINED AS 0011 

C THE INDEX OF THAT ARGUMENT WITH RESPECT TO THE FORTRAN 0012 

C COMMON BLOCK. 0013 

C 0014 

C THUS IXCARG PERMITS ACCESS TO LITERAL DATA IN A CALLING 0015 

C SEQUENCE, A PRINCIPAL USE BEING TO LOCATE HOLLERITH DATA* 0016 

C 0017 

C LANGUAGE - FORTRAN II SUBROUTINE 0018 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0019 

C STORAGE - 35 REGISTERS 0020 

C SPEED - 42 MACHINE CYCLES PLUS TWO CALLS OF XLOCF 0021 

C AUTHOR - SmHJ SIMPSON, MARCH 1963 0022 

C 0023 

C — USAGE — — 0024 

C 0025 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0026 

C AND FORTRAN SYSTEM ROUTINES - XLOC 0027 

C 0028 

C FORTRAN USAGE 0029 

C CALL I XCARGl ARG, IXCOM ) 0030 

C 0031 

C INPUTS 0032 

C 0033 

C ARG IS THE ARGUMENT WHOSE LOCATION IS DESIRED 0034 

C 0035 

C OUTPUTS 0036 

C 0037 

C IXCOM IS THE INDEX OF ARG WITH RESPECT TO COMMON 0038 

C I.E. IF THE CALLING PROGRAM HAS THE FOLLOWING 0039 

C STATEMENTS 0040 

C DIMENSION CM(2) 0041 

C COMMON CM 0042 

C THEN CM( IXCOM) EQUALS ARG 0043 

C 0044 

C EXAMPLES 0045 

C 0046 

C I. TYPICAL USE TO LOCATE LITERAL HOLLERITH DATA 0047 

C (NOTE HOW OUTPUT SHOWS FAP-STYLE STORAGE WITH FENCE)! 0048 

C USAGE - DIMENSION CM(2) 0049 

C COMMON CM 0050 

C CALL IXCARG(18HFIRST, SECOND, THIRD, IXCOM) 0051 

C OUTPUTS - CMKIXCOM) * 6HFIRST, 0052 

C CMfclXCOM-l) = 6HSEC0ND 0053 

C CMUXCCM-2) = 6H, THIRD 0054 

C CMCIXC0M-3) * OCT 777777777777 {THIS IS THE FENCE) 0055 

C 0056 

C 2* LOCATION OF LITERAL CONSTANTS 0057 

C USAGE - CALL IXCARGC 3. 14159265, IXCOM ) 0058 

C OUTPUTS - CM I IXCOM) * 3.14159265 0059 

C 0060 

C PROGRAM FOLLOWS BELOW 0061 

DIMENSION CM(2) 0062 

COMMON CM 0063 

IXCOM » XLOCFICM) - XLOCFf ARG) +1 0064 

RETURN 0065 

END 0066 



*•••**••*•»•»*»•*«•«*•*» PROGRAM LISTINGS #«##♦*«♦»#»»»»«•*•»**•## 

« KIINT1 » 4 KIINT1 • 

••**#•*•»•**««•*•*»*••** *•*••*••***•••*•••**••** 



— ABSTRACT 



TITLE - KIINT1 

PROBABILITY THAT A CHI- 



LANGUAGE 

EQUIPMENT 

STORAGE 

SPEED 

AUTHOR 



KIINT1 PRODUCES THE PROBABILITY THAT A CHI-SQUARED VARIATE 
WILL EXCEED A GIVEN VALUE. THIS PROBABILITY IS COMPUTED BY 
EQUATIONS GIVEN BY YULE AND KENDALL, 1950* THEORY OF 
STATISTICS, PAGE 464 i FOOTNOTE ) FOR NDF LESS THAN 31, 
WHERE NDF * NO. DEGREES OF FREEDOM. 
FOR HIGHER NDF THE NORMAL APPROXIMATION IS USED. 
WHEN THE NORMAL APPROXIMATION IS USED A TABLE OF THE 
NORMAL DISTRIBUTION WHICH APPEARS IN SUBROUTINE N0INT1 IS 
USED AND, SINCE THIS TABLE HAS ONLY 201 VALUES 
CORRESPONDING TO VALUES OF X CUNIT NORMAL) FROM 
0.0 TO 4.0, PROBABILITIES LESS THAN .00032 ARE SET TO ZERO 
AND THOSE GREATER THAN 99968 ARE SET EQUAL TO ONE* THIS 
DOES NOT OCCUR IF THE EQUATIONS ARE USED. 

FORTRAN II SUBROUTINE 
709 OR 7090 (MAIN FRAME ONLY) 
191 REGISTERS 



- S.M. SIMPSON 



-USAGE 



TRANSFER VECTOR CONTAINS ROUTINES - 
AND FORTRAN SYSTEM ROUTINES - 

FORTRAN USAGE 

CALL KI I NT1 CCHI SQ,NDF, PROB, I ANS ) 



NO I NT 1 
SQRT, EXPO 



* KIINT1 (SUBROUTINE) 

» LABEL 
CKIINT1 

SUBROUTINE KIINT1 (CH ISQ, NDF, PROB, I ANS ) 

C 
C 
C 
C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 



9/29/64 LAST CARD IN DECK IS NO. 



SQUARED VARIATE EXCEEDS A VALUE. 



INPUTS 



CHISQ 



IS THE PARTICULAR VALUE OF 
MUST BE GRTHN^O. 



A CHI-SQUARED VARIATE* 



NDF 



OUTPUTS 



PROB 



IANS 



EXAMPLES 



IS THE NUMBER OF DEGREES OF FREEDOM OF THE VARIATE. 
MUST BE GRTHN 0. 



IS THE PROBABILITY THAT THE VARIATE GRTHN=CHISQ. 



=0 
= 1 

=2 



NORMAL 

ILLEGAL CHISQ 
ILLEGAL NDF 



THE AGREEMENT BETWEEN THE PROB VALUE IN THE EXAMPLES AND THE 
COMPUTED PROB VALUE IS TO 3 OR FOUR PLACES SINCE 4 PLAC8 TABLES 
WERE USED TO MAKE UP THE EXAMPLES. 



2. 



3. 



4. 



5. 



0128 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 



INPUTS 




NDF=1 


CHISQ=-1. 


0060 


OUTPUTS 




ERROR 


IANS=1 


0061 










0062 


INPUTS 




NDF=0 


CHISQ^i. 


0063 


OUTPUTS 




ERROR 


IANS=2 


0064 










0065 


INPUTS 




NDF=l 


CHISQ=i. 


0066 


OUTPUTS 




PROB*. 


3179 IANS^O 


0067 










0068 


INPUTS 




NDF=8 


CHISQ=2.7330 


0069 


OUTPUTS 




PROB=. 


95 IANS=.0 


0070 










0071 


INPUTS 




NDF=21 


CHISQ=38.932 


0072 


OUTPUTS 




PROB*. 


01 IANS^O 


0073 



0074 



••••••••»#*«••••••••*•*• PROGRAM LISTINGS 

* KIINJ1 * # KIINT1 » 

*••*•»•••»»•*•»»•••*•••* **•*••••»***•••••**•••** 

(PAGE 2) ( PAGE 21 



C 6* INPUTS — NDF^O CHISQ=43.773 




0075 


C OUTPUTS ~ PROb*.u!> 




0076 


C 




0077 


C 7. INPUTS — NDF-31 f CHI 50=17. 




0078 


C OUTPUTS — PR0B=.98 IANS=0 




0079 


C 




0080 


/* o f kirn iTr i r\r- -> rut <*A-.i 

C 8. INPUTS — NDF-3 CHISQ=2.366 




0081 


C OUTPUTS — PRuo^.SO I AN5—0 




0082 


c 




0083 


c 




0084 


C INITIALIZE AND CHECK IF NORMAL CURVE APPROXIMATION IS TO BE 


USED. 


0085 


IANS=1 




0086 


IF ( CHI SQ) 9999 t 10 t 10 




0087 


10 IANS=2 




0088 


vc i All***? % AAA A aaaa 1 o 

IFlNDF) 9999»9999 f 12 




0089 


12 IANS=0 




0090 


15 CHI=SQRTF(CHISQI 




0091 


IF (NDF— 30) 20*20*70 




0092 


C PROB IS COMPUTED IN THE FORM PROB = P1+P2*P3. CHECK NDF FOR 


r urn ^ nnr\ 

EVENf ODD^ 


0093 


20 P2 3!t (2*71828 183) #» (-CHISQ/2.0 ) 




0094 


NDFH=NDF/2 




0095 


IF (NDF— 2*NDFH) 25*25*30 




0096 


C EVEN. SET Pl-Uf AND PS^l.O IF NDr=Z. 




0097 


25 P1=0.0 




0098 


tr (kmc t \ O T IT C /> 

IF (NDF— 2) Z7*Z7*50 




0099 


27 P3=1.0 




0 100 


bu TO 60 




0101 


f r\nr\ rnuniiTr n 1 unmcv o*> Akin c ct no.»n n tc iinc» i 
L ODD. COMPUTE Pl» MODIFY PZ AND bcT P3 S 0*0 Ir NUr * 1» 




0102 


•an. r At i klPTMTl » rut ;di I 
3U CALL riV 1 M 1 1 ILn I»rl) 




0103 


Pl-Z.U»li. 0— P i J 




0104 


PZ=CHI •PZ** 79788480 




0105 


Ir INDr— LJ 35*a!>»50 




0106 


1 ir n ^ n n 

35 P3 S 0.0 




0107 


A "1* A r A 

GO TO 60 




0108 


/* r\/Ai 1 1 a Tc n i ac a nnhuunuT cno tine poc atcd tuaai t 
C EVALUATE P3 A5 A PuEYNUMIAL FUR NDF bKcAIcK 1 MAN Z« 




0109 


C A Al 1 AA w\ imr u i 

50 NLOOPS^NDFH— 1 




0110 


P3— 1 • 0 




0211 


C Ir NUr = J INLUOPS-Ulf P3 = l« 




0112 


IrlNLOUPbi 60«OUf!>Z 




0113 


5Z UlV s NUr- Z 




0114 


nn cc t — 1 mi nriDC 






P3=P3»CHI 5>y/uIV"kl«U 




0116 


55 DIV=DIV— 2*0 




0117 


bU TO 60 




0118 


C COMBINE PIECES TO FORM PROB. 




0119 


60 PR0B»P1+P2»P3 




0120 


GO TO 9999 




0121 


C USE NORMAL APPROXIMATION FOR NDF GREATER THAN 30* 




0122 


70 CHI M0D=CHI*1.414214-SQRTF<FL0ATF( NDF )*2. 0-1.0) 




0123 


CALL N0INTUCHIi0D,Pl) 




0124 


PR0B=1.0-P1 




0125 


GO TO 9999 




0126 


9999 RETURN 




0127 


END 




0128 



*••»«•••*••»»»••••*••**• 

• KOLAPS • 



PROGRAM LISTINGS 



**•«****»••*•##*••*»•••• 
« KOLAPS ♦ 
*••«»••••••*•«•*•••••*** 



• KOLAPS (SUBROUTINE) 9/29/64 LAST CARD IN BECK IS NOL 0218 

• FAP 0001 
•KOLAPS 0002 

COUNT 200 0003 

LBL KOLAPS 0004 

ENTRY KOLAPS ( XMID, M, TYPE, L, CMID, ERR) 0005 

» 0006 

» ABSTRACT 0007 

• 0008 
« TITLE - KOLAPS 0009 
« COLLAPSE QDD-LENGTHED VECTOR ABOUT ITS MIDPOINT 0010 

• 0011 

• KOLAPS REDUCES A VECTOR XII) I=-M,... ,0,...#M T6 ANOTHER 0012 

• VECTOR CCD I« ~L,...,0, i..,L BY THE OPERATION 0013 
« C(I) = XU)+X(I+2*L)+X<l-2«L)+XI I+4»L)*X< I~4*L1**.. 0014 

• FOR 1= -(L-Ut...fOM».iL-l 0015 

• WHERE SUMMATION TERMINATES AS X SERIES TERMINATES 0016 
« C(L) = C(-L) = ONE-HALF VALUE FROM ABOVE EXPRESSION 0017 

• KOLAPS HANDLES BOTH FIXED AND FLOATING POINT VECTORS* 0018 

• OUTPUT MAY BE STORED ON TOP OF INPUT. 0019 

• 0020 
« LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0021 

• EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0022 
« STORAGE - 100 REGISTERS 0023 

• SPEED - ABOUT 12*M MACHINE CYCLES, FOR FIXED PT. DATA 0024 

• ABOUT 21*M MACHINE CYCLES, FOR FLOATING PTJ DATA 0025 

• AUTHOR - J. CLARK 10/61 0026 

• 0027 
» >-USAGE 0028 

• 0029 
« TRANSFER VECTOR CONTAINS ROUTINES - NONE 0030 

• AND FORTRAN SYSTEM ROUTINES - NONE 0031 

• 0032 

• FORTRAN USAGE 0033 
« CALL KOLAPS(XMID,M»TYPE,L, CMID, ERR ) 0034 
« 0035 

• INPUTS 0036 

• 0037 
» XMID(I) CONTAINS THE TWO-SIDED VECTOR X(J) J* -M, . , 0,. ,M 0038 

• SUCH THAT XMID(l) = X(0) , I.E. 0039 
« XMID(I) » X(I-l) I*-M+l,i.i,M+l 0040 

• XMID MAY BE FLOATING POINT OR FIXED POINT 0041 

• 0042 

• M DEFINES LENGTH OF X TO BE 2»M+1 0043 
» MUST NOT BE NEGATIVE 0044 

• 0045 

• TYPE * 0.0 SIGNIFIES X(I) IS FIXED POINT 0046 
« NOT * 0.0 SIGNIFIES XU) IS FLOATING POINT 0047 

• 0048 
» L DEFINES LENGTH OF COLLAPSED VECTOR TO BE 2*L+1 0049 

• MUST EXCEED ZERO. MAY EXCEED M. 0050 

• 0051 
» OUTPUTS 0052 

• 0053 

• CMID(I) CONTAINS THE COLLAPSED VECTOR CiJ) J» -L,.J.,L 0054 
» SUCH THAT CMID(l) » C(0) I.E. 0055 
» CMID(I) * C(I-l) I * -L+1,.4.,L*1 0056 

• WHERE CU) IS DEFINED IN ABSTRACT ABOVE 0057 
« EQUIVALENCE (XMID, CMID) IS PERMITTED 0058 
» 0059 

• ERR * 0.0 NORMALLY 0060 

• = 1.0 IF L OR M IS ILLEGAL 0061 
» = 2.0 IF OVERFLOW OCCURS 0062 

• 0063 

• EXAMPLES 0064 

• 0065 
» IN ALL EXAMPLES, INPUTS ARE ASSUMED TO BE THE SAME AS 0066 
» EXAMPLE 1. UNLESS OTHERWISE STATED C067 

• 0068 

• 1. ORDINARY USA6E (FIXED OR FLOATING) 0069 

• INPUTS - XXU...9) * l.,3.,2.,l.,3.,5.,l.,l.,l. 0070 

• IXX(1...9)= 10,30,20,10,30,50,10,10,10 0071 
» USAGE - CALL KOLAPS ( XX ( 5 ) ,4, 1.0, 2, CC ( 3) ,ERR 1 I 0072 

• CALL KOLAPS( IXX( 5 ) ,4,0. , 2, ICC(3),ERR2) 0073 

• OUTPUTS - CC(1... 5) * 1.5, 2. ,5. ,8., 1.5 ERR1*0. 0074 
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• 






ICCd.j.5) = 15,20, 50,80, 15 ERR2=0. 


0075 


• 








0076 


• 


2* 


STORAGE 


OF OUTPUT ON TOP OF INPUT i FIXED OR FL0ATING1 


0077 


• 




USAGE 


CALL KGLAPS(XX(5)*4, 1.0,2, XX(5),ERR1> 


0078 


• 






CALL KOLAPS ( IXX( 5 ) ,4,0. , 2, IXX(5),ERR2) 


0079 


• 




OUTPUTS 


- XXU...9) = l.,3., 1.5,2*, 5., 8., 1.5, 1., 1. 


0080 


• 






IXX(1.**.9) * 10,30,15,20,50,80,15,10,10 


0081 


• 








0082 


• 


3* 


SPECIAL 


CASE - L*M (FLOATING) 


0083 


• 




USAGE 


CALL K0LAPS(XX(3),2,i.,2,CC(3),ERR) 


0084 


• 




OUTPUTS 


- CCftl..^5) * 2.,3.,2.,1.,2. ERR*0. 


0085 


• 








0086 


* 


4* 


SPECIAL 


CASES - L EXCEEDS M AND M=0 


0087 


• 




USAGE 


CALL K0LAPS(XX(3),2,1.,4,CC(5),ERR1) 


0088 


• 






CALL KOLAPS ( I XX ,0,0. ,2, ICC (3) ,ERR2) 


0089 


• 




OUTPUTS 


- CCC1..J9) fe 0.,0.,l.,3.,2.,l.,3.,0.,0. ERR1 * 0. 


0090 


* 






ICC(l...5) = 0,0,10,0,0 


0091 


• 








0092 


• 


5. 


ERROR CONDITIONS 


0093 


• 




USAGE - 


CALL K0LAPS(XX,~1,1.,2,CC,ERR1) 


0094 


• 






OR CALL K0LAPS(XX,0,1.,0,CC,ERR2) 


0095 


* 




OUTPUTS 


- ERR1 = 1. (ILLEGAL M) 


0096 


• 






ERR2 = 1. (ILLEGAL L) 


0097 


• 








0098 


* 


6* 


INPUTS 


- IXXU...5) * 90000,90000,90000,90000,90000 


0099 


« 




USAGE 


CALL KOLAPS ( I XX (3), 2, 0.,1, ICC (2), ERR I 


0100 


• 




OUTPUTS 


- ERR * 2. (OVERFLOW) 


0101 


• 








0102 






HTR 


0 


0103 






BCI 


UKOLAPS 


0104 


KOLAPS SXD 


KOLAPS-2,4 


0105 






SXA 


LEAVE+1,1 


0106 






SXA 


LEAVE+2,2 


0107 


• 


GET L AND CHECK IT (MUST EXCEED ZERO) 


0108 






CLA 


KF1 


0109 






STO 


ERR 


0110 






CLA» 


4,4 


Oil 1 






TMI 


LEAVE 


0112 






TZE 


LEAVE 


0113 






STD 


KL 


0114 


• 


SET UP FOR 


FIXED OR FLOATING 


0115 






AXT 


0,1 


0116 






ZET» 


3,4 


0117 






AXT 


-ia 


0118 






CLA 


KADDl , 1 


0119 






STO 


N0P2 


0120 






CLA 


KADD2, I 


0121 






STO 


N0P3 


0122 






CLA 


KLRS,1 


0123 






STO 


N0R4 


0124 


* 


SET DECREMENTS ETC. DEPENDING ON L,M 


0125 






CLA 


KL 


0126 






STD 


TXI3 L 


0127 






POC 


0,1 


0128 






SXD 


TXI4,1 -L 


0129 






ADD 


KL 


0130 






STD 


TXU 2L 


0131 






PDC 


0,1 


0132 






SXD 


TXI2,1 -2L 


0133 






SUB 


KDi 


0134 






STD 


TXLl 2L-1 


0135 






CLA* 


2,4 


0136 






TMI 


LEAVE ( ILLEGAL M EXIT) 


0137 






STD 


TXH1 M 


0138 






STD 


KTXH 


0139 






ADD 


KDI 


0140 






PDC 


0,1 -M-l 


0141 






SXD 


TXH2,1 


0142 






SXD 


KTXL,1 


0143 






CLA 


KTXL 


0144 






STO 


N0P1 


0145 


• 


SET ADDRESS XMID,CMID 


0146 






CLA 


1,4 


0147 






STA 


N0P2 


0148 






STA 


N0P3 


0149 
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CLA 


5,4 




0150 




STA 


STO 




0151 




STA 


CLA 




0152 




STA 


STQl 




0153 




STA 


STQ2 




0154 


• MAIN 


LOOP. SETS CCIi I=- 


L,...,L-1 


0155 


♦ NOTES - XR4 


CONTROLS I 




0156 


• 


- XR1 


CONTROLS XU),X(I-2L),... (XR1 GETS BUMPED DOWN ) 


0157 


• 


- XR2 


CONTROLS X(I+2L),XU+4L), ... ( XR2 GETS BUMPED UP* 


0158 


♦SUMMATION IN \ 


PAIRS BY XR1 


,XR2 MEANS, WHEN XR1 EXCEEDS BOUNDS SO MILL XR2 


0159 




CLA 


KF2 




0160 




STO 


ERR 




0161 




TOV 


*+l 




0162 




LOC 


KL#4 


START WITH I=-L IXR4=-L> 


0163 


♦ OUTER LOOP 






0164 


OUTR 


CLA 


KO 


CLEAR AC 


0165 




PXA 


0,4 




0166 




PAX 


0,1 


INITIALIZE XR1 AND XR2 TO I 


0167 




PAX 


0,2 




0168 


» (CHECK IF FIRST X(I) IS 


OUTSIDE RANGE. IF SO, STORE ZERO) 


0169 


NOP1 


NOP 




= TXL ST0,1,~M~1 FOR I=~L,.J.,-I 


0170 


• 






* TXH ST0,1,M FOR 1*0, 1, . . . , L-l 


0171 


* INNER LOOP 






0172 


TXI1 


TXI 


*+l,2,#* 


♦♦=2L (BUMP XR2 UP, LOWEST=+L> 


0173 


N0P2 


NOP 




ADD ♦♦,! OR FAD ♦♦,! ♦♦^XMID 


0174 


TXH1 


TXH 


«+2,2,*» 


♦ ♦teM 


0175 


N0P3 


NOP 




ADD «*,2 OR FAD **t2 ♦♦sXMID 


0176 


TXI2 


TXI 


♦♦1,1, *♦ 


♦♦ =-2L (XR1 IS NEG FOR ALL TESTS1 


0177 


TXH2 


TXH 


TXU%lV«* 


♦♦=-M-l 


0178 


• STORE AND CHECK FOR MORE 




0179 


STO 


STO 


»»#4 


♦♦=CMID 


0180 




TXI 


♦♦1,4,1 


BUMP XR4 


0181 




TXH 


TXI3»4*0 




0182 




CLA 


KTXH 


SWITCH TEST ON FIRST X(I) 


0183 




STO 


N0P1 


FOR 1=0 ON 


0184 


TXI3 


TXI 


♦♦1,4, ♦♦ 


♦♦*+L CHECK 


0185 


TXH 


TXL 


♦♦2,4, #♦ 


♦♦=2L-1 FOR 


0186 




TRA 


DONE 


COMPLETION 


0187 


TXI4 


TXI 


0UTR t 4tf «* 


**=-L BACK 


0188 


* PATCH UP ENOS 




0189 


DONE 


LDC 


KL,l 




0190 




LXD 


KL,4 




0191 


CLA 


CLA 


**a 


♦♦=CMID 


0192 


NOP4 


NOP 




=LRS 36 OR FDP KF2 


0193 


STQl 


STQ 


**tl 


♦♦«CMID 


0194 


STQ2 


STQ 


♦ ♦,4 


♦♦=CMID 


0195 




TOV 


LEAVE 




0196 




STZ 


ERR 




0197 


LEAVE 


LXD 


KOLAPS-2,4 




0198 




AXT 


♦♦,1 




0199 




AXT 


**4 2 




0200 




CLA 


ERR 




0201 




STO» 


6,4 




0202 




TRA 


7,4 




0203 


KO 


PZE 


0 




0204 


KF2 


DEC 


2.0 




0205 


KFi 


DEC 


1.0 




0206 


KL 


PZE 


0,0,^ 




0207 


KOI 


PZE 


0,0,1 




0208 


KLRS 


LRS 


36 


THE STORAGE 


0209 




FDP 


KF2 


ORDER 


0210 


KAOD1 


ADD 


0,1 


OF 


0211 




FAD 


0,1 


THESE SIX 


0212 


KADD2 


ADD 


0,2 


IS 


0213 




FAD 


0,2 


IMPORTANT 


0214 


KTXL 


TXL 


ST®,1,0 


**=-M-i 


0215 


KTXH 


TXH 


STO,l,^« 


♦ ♦=M 


0216 


ERR 


PZE 




♦♦=ERR SETTING =* 1.0,2.0,0.0 


0217 




END 






0218 
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• LIMITS (SUBROUTINE) 9/8/64 LAST CARD IN DECK IS NO* 0161 

• FAP 0001 
•LIMITS 0002 

COUNT 150 0003 

LBL LIMITS 0004 

ENTRY LIMITS ( I ANSX1 , I ANS , XI,XIA,X1B, X2,X2A,X2B, .J. t 0005 

• XN,XNA,XNB) 0006 

• 0007 

• 0008 

• -* ABSTRACT 0009 

• 0010 

• TITLE - LIMITS 0011 

• CHECK THAT VARIABLES FROM LIST FALL WITHIN GIVEN LIMITS 0012 

• 0013 

• LIMITS IS A VARIABLE-LENGTH-CALLING-SEQUENCE IROGRAM IN 0014 

• WHICH THE ARGUMENTS BEYOND THE SECOND OCCUR IN TRIPLETS* 0015 

• LIMITS CHECKS TO SEE IF THE FIRST MEMBER OF EACH TRIPLET 0016 

• LIES IN THE INCLUSIVE RANGE DEFINED BY THE NEXT TWO 0017 

• MEMBERS. IF THIS HOLDS FOR ALL TRIPLETS, THEN LIMITS 0018 

• SETS ITS SECONO ARGUMENT EQUAL TO ZERO. IF NOT* THEN ITS 0019 

• SECOND ARGUMENT IS SET EQUAL TO THE FIXED POINT SUM OF 0020 

• ITS FIRST ARGUMENT PLUS ONE LESS THAN THE INDEX OF THE 0021 

• FIRST TRIPLET FOUND TO FAIL THE TEST. 0022 

• 0023 

• THE TRIPLET ARGUMENTS MAY BE ANY MODE, AND *0 IS TREATED 0024 

• EQUAL TO -0 IN THE COMPARISONS. 0025 

• 0026 

• LANGUAGE - FAP SUBROUTINE (FORTRAN-II COMPATIBLE) 0027 

• EQUIPMENT - 709,7090,7094 (MAIN FRAME ONLY) 0028 

• STORAGE - 44 REGISTERS 0029 

• SPEED - ABOUT 26 ♦ 43N MACHINE CYCLES 0030 

• WHERE N NUMBER OF TRIPLETS 0031 
» AUTHOR - S.M. SIMPSON, JUNE 1964 0032 
» 0033 

• 0034 

• USAGE 0035 

» 0036 

• TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0037 

• AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0038 

• 0039 
« FORTRAN USAGE 0040 

• CALL LIMITS(IANSX1,IANS, XI,X1A,X1B, X2,X2A,X2B, ..J, XN,XNA,XNB) 0041 

• 0042 

• 0043 

• INPUTS 0044 

• 0045 

• IANSX1 IS ANY FIXED POINT NUMBER, PREFERABLY GRTHN- l* 1 WHICH IS 0046 
» TO BE THE OUTPUT VALUE OF IANS IN THE CASE TWAT XI 0047 
» FAILS TO LIE WITHIN X1A TO X1B. 0048 

• 0049 

• XI IS ANY MODE. 0050 
» X1A SHOULD BE SAME MODE AS XI. 0051 

• X1B SHOULO BE SAME MODE AS XI (MAY BE GRTHN, LSTHN OR EQUAL 0052 

• TO X1A). 0053 

• 0054 

• X2 IS ANY MODE, NOT NECESSARILY THE SAME AS XI. 0055 
» X2A SAME PIODE AS X2. 0056 

• X2B SAME MODE AS X2. 0057 

• 0058 
» (ETC UP THRU XNtXNAtXNB WHERE N SHOULD EXCEED ZERO)! 0059 

• 0060 
» 0061 

• OUTPUTS ILLEGAL RETURN OCCURS IF ARGUMENT COUNT MINUS 2 IS NOT A 0062 

• MULTIPLE OF 3. 0063 

• 0064 
» LET XJ,XJA,XJB STAND FOR J-TH TRIPLET, J=I,2,.J.,N 0065 

• AND LET XJLO * MIN(XJA,XJB) , XJHI = MAXCXJA^X JB ) . 0066 

• THEN 0067 
» 0068 

• IANS » 0 IF XJLO LSTHN* XJ LSTHN* XJHI, FOR ALL J. 0069 

• = IANSXi+K-1 IF XK FAILS TO SATISFY ABOVE EQUATION, 0070 

• WHERE K IS THE LOWEST J VALUE FOR WHICH FAILURE 0071 

• OCCURS. 0072 

• 0073 
» 0074 
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• EXAMPLES 0075 

• 0076 

• 1. ZERO TESTS 0077 

• USAGE - CALL LIMITS( 1, IANSt -0,-0,1, -0,+0,U «-0,-0»l, 0078 
» 1 +0,+0,l, -0,-1,-0, -0,-1, +0, +0,-1,-0,1 *0fr~'U+0* 0079 

• 2 +0,+0,+0, +0,+0,-0, +0,-0,+0, +0,-0,-0, 0080 

• 3 ~0,+0,+0, -0,+0,-0, -0,-0, +0, -0,-0,-0) 0081 

• OUTPUTS - IANS * 0 0082 

• 0083 

• 2. GENERAL TESTS 0084 

• USAGE - CALL LIMITS( 1, IANS1, 1.0, 2.0, 3.0) 0085 

• CALL LIMITS(21,IANS2, 3,1,4, 3.,l.,4i, -3.,-4J*-l*# 0086 

• 1 1,1,4, 1,2,3, 4,1,4) 0087 

• CALL LIMITS( 31,IANS3, 0.,0.,0., 1,1,1, -1,-1,-1* 0088 

• 1 3,1,2, 0,1,2) 0089 
» OUTPUTS - IANS1 » 1, IANS2 * 25, I AN S3 = 34 0090 

• 0091 

• 3. USAGE -/SAME AS EXAMPLE 2. BUT REVERSING THE ORDER OF THE SECOND 0092 

• AND THIRD MEMBER OF EACH TRIPLET* 0093 

• OUTPUTS - SAME AS EXAMPLE 2. 0094 
» 0095 

• 0096 
» PROGRAM FOLLOWS BELOW 0097 
» 0098 

BCI 1, LIMITS 0099 

• 0100 
» ONLY ENTRY. LIMITS 1 1 ANSX1 , I ANS , X1,X1A,XIB, X2,X2A,X2B^ ..*) 0101 
» 0102 
LIMITS SXA D0NE,1 0103 

CLA 1,4 A(IANSXl) 0104 

STA ADD 0105 

CLA 2,4 A(IANS) 0106 

STA STO 0107 

AXT 0,1 XR1 IS TRIPLET INDEX MINUS 1 0108 

STZ» 2,4 (INITIALIZE IANS TO ZERO) 0109 

• 0110 
» CHECK FOR ANOTHER TRIPLET 0111 
» 0112 

CAL CAL 3,4 0113 

ANA AMASK 0114 

LAS TSXZ IS C(3,4) A TSX X,0 INSTRUCTION 0115 

TRA DONE NO 0116 

TRA CHECK YES 0117 

DONE AXT ***1 NO ( ♦* = XR1 INITIAL) 0118 

TRA 3,4 0119 

» 0120 

• COMPARE X AND XLO, UNLESS WE HAVE ALREADY FOUND A DISCREPANCY^ 0121 
» 0122 

CHECK ZET» STO 0123 

TRA TXI 0124 

CLA» 5,4 X1B 0125 

LDQ* 4,4 X1A 0126 

TLQ *+2 0127 

XCA 0128 

STO XHI 0129 

STQ XLO 0130 

CLA* 3,4 X 0131 

TNZ CASl 0132 

SSP (BIG ZERO FOR LOW CHECK) 0133 

CASl CAS XLO X AGAINST XLO 0134 

TRA OKLO OK 0135 

TRA OKLO OK 0136 

» 0137 

• SET IANS FOR DISCREPANCY 0138 
» 0139 

BAD PXD 0,1 0140 

ADD ADD »* »* * A(IANSXl) 0141 

STO STO *» *« = A(IANS) 0142 

TRA TXI 0143 

« 0144 

» COMPARE X AND XHI 0145 

» 0146 

OKLO TNZ CAS2 0147 

SSM (LITTLE ZERO FOR HI CHECK) 0148 

CAS2 CAS XHI X AGAINST XHI 0149 
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TRA BAD X TOO BIG 0150 

NOP OK 0151 

TXI TXI *+l,i,l OK, 0152 

TXI CAL,4,-3 TRY ANOTHER. 0153 

» 0154 

• CONSTANTS 0155 

« 0156 

AMASK OCT 777777700000 0157 

TSXZ TSX 0,0 0158 

XLO PZE ««,«♦,#♦ 0159 

XHI PZE ♦»*##,#« 0160 

ENO 0161 
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• LINE (7091 C SUBROUTINE ) 9/29/64 LAST CARO IN DECK IS NO* 0192 
« FAP 0001 
•LINE (709) 0002 

COUNT 150 0003 

LBL LINE 0004 

ENTRY LINE CX1,Y1.X2,Y2) 0005 

• 0006 

• — * — ABSTRACT 0007 

» 0008 

• TITLE - LINE (709) 0009 
» FAST, ARBITRARY STRAIGHT LINE SEGMENT ON SCOPE 0010 
» 0011 

• LINE PLOTS A STRAIGHT LINE FROM A POINT (X1»Y1) TO A 0012 

• POINT (X2,Y2) ON THE SCOPE. THE PLOTTING DENSITY IS 0013 
» ADJUSTED SO THAT THE SEPARATION BETWEEN INDIVIDUAL POINTS 0014 

• WILL BE LSTHN=2.0 ANO GRTHN=1.414 SCOPE UNITS, 0015 

• 0016 

• LANGUAGE - FAP » SUBROUTINE (FORTRAN II COMPATIBLE) 0017 
» EQUIPMENT - 709 < MAIN FRAME AND SCOPE UNIT) 0018 
» STORAGE - 91 REGISTERS 0019 
» SPEED - MAXIMUM 0020 

• AUTHOR - S.M. SIMPSON 0021 
» 0022 

• — — USAGE 0023 

» 0024 

• TRANSFER VECTOR CONTAINS ROUTINES - NONE 0025 
» AND FORTRAN SYSTEM ROUTINES - NONE 0026 

• 0027 

• FORTRAN USAGE 0028 

• CALL LINE (XltYltX2*Y2) 0029 

• 0030 

• INPUTS 0031 
•XI IS X COORDINATE OF 1 END OF LINE TO BE PLOTTED. 0032 

• Yi IS Y COORDINATE OF I END OF LINE TO BE PLOTTED. 0033 

• X2 IS X COORDINATE OF 2 END OF LINE TO BE PLOTTED* 0034 

• Y2 IS Y COORDINATE OF 2 END OF LINE TO BE PLOTTED. 0035 

• 0036 

• NOTES 0037 

• X1,Y1,X2,Y2 ARE FLOATING POINT NUMBERS. 0038 

• MUST BE LSTHN 1024. GRTHN«0. 0039 

• IF ARE GRTHN=1024. OR LSTHN 0 NO LINE 0040 

• IS PLOTTEO. 0041 

• 0042 
» OUTPUTS LINE PLOTTED ON THE SCOPE 0043 

• 0044 

• EXAMPLES 0045 

• 1. INPUTS - Xl*10. Yl=50. X2=1000. Y2*50. 0046 
» 0047 

• 2. INPUTS - Xl*50. Yl=10. X2=50. Y2=1000. 0048 

• 0049 

• 3. INPUTS - Xl*200. Yl*20. X2=500. Y2«1000. 0050 

• 0051 

• 4. INPUTS - Xl*700. Yl-1000. X2=500. Y2=20. 0052 

• 0053 

• 5. INPUTS - X1*100G. Yl=200. X2=10. Y2=500. 0054 

• 0055 

• 6* INPUTS - X1*0. Yl = 1023. X2 = 1023. Y2=*0. 0056 

• 0057 

• 7. INPUTS - Xl*750. Yl=750. X2*750. Y2*750. 0058 

• 0059 

• OUTPUTS - THE NUMBERS ON THE DISPLAY CORRESPOND TO THE EXAMPLE 0060 
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* NUMBER. IT IS PLOTTED NEAR THE XI, Yl POINT. 0061 

* 0062 
» 0063 

0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 

* 0086 

* 0087 

* 8. INPUTS - Xl*-4. Yl=5. X2*5. Y2=5. 0088 

* 0089 
» 9. INPUTS - Xl*1024.15 Yl = 5. X2=5. Y2*5. 0090 

* 0091 

* OUTPUTS - NOTHING IS PLOTTED. 0092 
» 0093 
•SAVE INDEX REG AND CHECK LEGALITY OF ARGUMENTS 0094 

LINE SXA LV.l 0095 

CLA« 1,4 0096 
TSX CK#1 0097 

CLA» 2,4 0098 
TSX CK#l 0099 

CLA» 3,4 0100 
TSX CK#1 0101 

CLA» 4,4 0102 
TSX CKtl 0103 

TRA SET ALL OK 0104 

CK TMI LV BAD 0105 

CAS KL1024 0106 

NOP BAD 0107 

TRA LV BAD 0108 

TRA 1,1 OK 0109 

•SET INITIAL X AND Y 0110 
SET CLA* 1,4 XI 0111 

TSX FXil 0112 

ALS 18 0113 

STO PTRND 0114 

ALS 7 0115 

STO PTTRU 0116 

CLA* 2,4 Yl 0117 

TSX FX*1 0118 

ADD PTRND 0119 

STO PTRND 0120 

ANA AN 0121 

ALS 7 0122 

ADD PTTRU 0123 

STO PTTRU 0124 

•SET DELTA X, DELTA Y TIMES 2 EXP 7 0125 
CLA» 3,4 X2 0126 

FSB* 1,4 MINUS XI 0127 

STO DIFX 0128 

CLA* 4,4 Y2 0129 

FSB* 2,4 MINUS Yl 0130 

STO DIFY 0131 

•NO PTS PLOTTED WILL BE SET = ( MAG ( Y2-M )+MAG( X2-X1 ) }/2+l 0132 
CLA DIFX 0133 

SSP 0134 
FAM DIFY 0135 
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FDP 


KL2 




0136 




XCA 






0137 




TSX 


FX t l 




0138 




STO 


NNCSX 


STORE FXO PT NO. INCRS 


0139 




ORA 


ORF 




0140 




FAD 


ORF 




0141 




STO 


NNCSL 


STOR FLTG PT NO. INCRS 


0142 




LDQ 


DIFX 


FORM DELTA X ♦ 2EXP7 


0143 




FMP 


KL128 




0144 




FOP 


NNCSL 




0145 




XCA 






0146 




TSX 


FXtl 




0147 




ALS 


18 




0148 




STO 


XNTRU 




0149 




LDQ 


DIFY 


FORM DELTA Y ♦ 2EXP7 


0150 




FMP 


KL128 




0151 




FDP 


NNCSL 




0152 




XCA 






0153 




TSX 


FX»1 




0154 




STO 


YNTRU 




0155 


* SET FOR NO. 


PTS = = NO. INCRS PLUS 1 


0156 




LXA 


NNCSX, I 




0157 




TXI 


plt,i,i 




0158 


•PLOT LINE 






0159 


PLT 


«TV 






0160 


CPY 


CPY 


PTRNO 




0161 




CLA 


PTTRU 




0162 




ADD 


XNTRU 




0163 




ADD 


YNTRU 




0164 




STO 


PTTRU 




0165 




ARS 


7 




0166 




ANA 


AN2 


GET RID OF EXTRA BITS 


0167 




STO 


PTRND 




0168 




TIX 


CPY, I, I 




0169 


• EXIT 








0170 


LV 


AXT 


• ♦,1 




0171 




TRA 


5,4 




0172 


YNTRU 


PZE 


•**0,0 


Y INC TIMES 2 EXP 7 


0173 


XNTRU 


PZE 


0,0, •* 


X INC TIMES 2 EXP 7 


0174 


PTTRU 


PZE 


»*» 0, •* 


X Y TIMES 2 EXP 7 


0175 


PTRND 


PZE 


*«,0,»* 


X Y FOR SCOPE 


0176 


ORF 


OCT 


233000000000 




0177 


AN 


OCT 


000000777777 




0178 


OIFX 


PZE 


** 


FLOATING POINT X2-X1 


0179 


DIFY 


PZE 


** 


FLOATING POINT Y2 - Yl 


0180 


KL2 


DEC 


2.0 




0181 


NNCSL 


PZE 


*• 


* FLTG PT NO INCRS 


0182 


NNCSX 


PZE 


• » 


« FXD PT NO INCRS 


0183 


KL128 


DEC 


128. 


= 2EXP7 


0184 


KL1024 


DEC 


1024.0 




0185 


AN2 


OCT 


001777001777 




0186 


FX 


UFA 


ORF 




0187 




LRS 






0188 




ANA 


AN 




0189 




LLS 






0190 




TRA 


1,1 




0191 




END 






0192 
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• LINE (7090) (SUBROUTINE) 9/4/64 LAST CARD IN OECK IS NO. 0207 

• FAP 0001 
•LINE (7090) 0002 

COUNT 160 0003 

LBL LINE 0004 

ENTRY LINE ( XI , Yl ,X2, Y2 ) 0005 

• 0006 

« ABSTRACT 0007 

» 0008 

• TITLE - LINE (7090) 0009 

• FAST, ARBITRARY STRAIGHT LINE SEGMENT ON SCOPE 0010 

• 0011 

• LINE PLOTS A STRAIGHT LINE FROM A POINT <XUY1) TO A 0012 

• POINT (X2,Y2) ON THE SCOPE. THE PLOTTING DENSITY IS 0013 
» ADJUSTED SO THAT THE SEPARATION BETWEEN INDIVIDUAL POINTS 0014 

• WILL BE LSTHN=2.0 AND GRTHN*1.414 SCOPE UNITS. 0015 

• 0016 
» LANGUAGE - FAPi SUBROUTINE t FORTRAN II COMPATIBLE) 0017 

• EQUIPMENT - 7090 C MAIN FRAME, DATA CHANNEL D AND SCOPE) 0018 
» STORAGE - 95 REGISTERS 0019 
» SPEED - HORIZONTAL LINE ACROSS ENTIRE SCOPE FACE TAKES ABOUT 0020 
» .13 SEC - 709 0021 

• .026 SEC - 7090 0022 

• AUTHOR - S.M. SIMPSON 0023 

• 0024 
» -—USAGE 0025 

• 0026 

• TRANSFER VECTOR CONTAINS ROUTINES - NONE 0027 

• AND FORTRAN SYSTEM ROUTINES - NONE 0028 
» 0029 

• FORTRAN USAGE 0030 

• CALL LINE <X1,Y1,X2,Y2) 0031 
« 0032 

• INPUTS 0033 

• 0034 
•XI IS X COORDINATE OF 1 END OF LINE TO BE PLOTTED. 0035 
» 0036 

• Yl IS Y COORDINATE OF 1 END OF LINE TO BE PLOTTED. 1 0037 

• 0038 

• X2 IS X COORDINATE OF 2 END OF LINE TO BE PLOTTED. 0039 

• 0040 

• Y2 IS Y COORDINATE OF 2 END OF LINE TO BE PLOTTED. 0041 

• 0042 

• NOTES 0043 

• Xl,Yl,X2,Y2 ARE FLOATING POINT NUMBERS. 0044 

• MUST BE LSTHN 1024. GRTHN*0. 0045 

• IF ARE GRTHN=1024. OR LSTHN 0 NO LINE 0046 

• IS PLOTTED. 0047 

• 0048 

• OUTPUTS LINE PLOTTED ON THE SCOPE 0049 

• 0050 
» EXAMPLES 0051 

• 0052 
» 1. INPUTS - Xl*10. Yl*50. X2*1000. Y2«50. 0053 

• 0054 
» 2. INPUTS - Xl*50. Yl*10. X2*50. Y2=1000. 0055 

• 0056 

• 3* INPUTS - Xl*200. Yl=20. X2=500. Y2=1000. 0057 

• 0058 

• 4. INPUTS - Xl*700. Yl=1000. X2»500. Y2=20. 0059 

• 0060 

• 5. INPUTS - X1=*100G. Yl=200. X2*10. Y2=500. 0061 

• 0062 

• 6. INPUTS - X1=*0. Yl-1023. X2=1023. Y2*0. 0063 

• 0064 

• 7. INPUTS - Xl*750. Yl=750. X2*750. Y2=750. 0065 

• OUTPUTS - THE NUMBERS ON THE DISPLAY CORRESPOND TO THE EXAMPLE 0066 
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* NUMBER. IT IS PLOTTEO NEAR THE XI, Yl POINT* 0067 

* 0068 

0069 
0070 
0071 
0072 
0073 
0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 

* 0091 

* 0092 

* 8. INPUTS - Xl*-4. Yl*5. X2=5. Y2=5. 0093 

* 0094 

* 9. INPUTS - Xl*1024.15 Yl=5. X2=5. Y2=5. 0095 

* OUTPUTS - NOTHING IS PLOTTED. 0096 

* 0097 

* 0098 

* PROGRAM FOLLOWS BELOW 0099 




• 






0100 


* FOLLOWING 


CARD DESIGNATES 


THE DATA CHANNEL THAT CRT IS ATTACHED TO* 


0101 


* TO CHANGE, 


ALTER THE LETTER DESIGNATION ONLY AND REASSEMBLE* 


0102 


X TAPENO Dl 




0103 


SCPAO EQU 


X-105 




0104 


♦SAVE INDEX 


REG AND CHECK LEGALITY OF ARGUMENTS 


0105 


HTR 


0 




0106 


BCI 


lftrlNE 




0107 


LINE SXD 


LINE-2^4 




0108 


SXA 


LVtl 




0109 


CLA* 


1,4 




0110 


TSX 


CKjl 




0111 


CLA* 


2,4 




0112 


TSX 


CKU 




0113 


CLA» 


3,4 




0114 


TSX 


cka 




0115 


CLA» 


4,4 




0116 


TSX 


CKU 




0117 


TRA 


SET 


ALL OK 


0118 


CK TMI 


LV 


BAD 


0119 


CAS 


KLI024 




0120 


NOP 




BAD 


0121 


TRA 


LV 


BAD 


0122 


TRA 


It! 


OK 


0123 


•SET INITIAL 


X AND Y 




0124 


SET CLA* 


1,4 


XI 


0125 


TSX 


FX41 




0126 


ALS 


18 




0127 


STO 


PTRND 




0128 


ALS 


7 




0129 


STO 


PTfRU 




0130 


CLA* 


2,4 


Yl 


0131 


TSX 


FX^l 




0132 


ADD 


PTRND 




0133 


STO 


PTRND 




0134 


ANA 


AN 




0135 


ALS 


7 




0136 


ADD 


PTTRU 




0137 


STO 


PTTRU 




0138 


•SET DELTA X 


, DELTA Y TIMES 


2 EXP 7 


0139 


CLA* 


3,4 


X2 


0140 


FSB* 


1.4 


MINUS XI 


0141 
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STO DIFX 

CLA* 4,4 

FSB* 2,4 

STO DIFY 
•NO PTS PLOTTED WILL 

CLA DIFX 
SSP 

FAM DIFY 

FDP KL2 
XCA 

TSX FX#l 

STO NNCSX 

ORA ORF 

FAD ORF 

STO NNCSL 

LDQ DIFX 

FMP KL128 

FDP NNCSL 
XCA 

TSX FX,1 

ALS 18 

STO XNTRU 

LDQ DIFY 

FMP KL128 

FDP NNCSL 
XCA 

TSX FX, I 

STO YNTRU 
* SET FOR NO. PTS * = NO. INCRS PLUS 1 





LXA 


NNCSX, 1 






TXI 


PLT ,1,1 




•PLOT LINE 






PLT 


WRS 


SCPAD 






RCHX 


10 






CLA 


PTTRU 






ADD 


XNTRU 






ADD 


YNTRU 






STO 


PTTRU 






ARS 


7 






ANA 


AN2 


GET RID OF EXTRA BITS 




STO 


PTRND 






TIX 


PLT, 1,1 




•EXIT 








LV 


AXT 


**, 1 






TRA 


5,4 




10 


IOCD 


PTRND, 0,1 




YNTRU 


PZE 


••♦0,0 


Y INC TIMES 2 EXP 7 


XNTRU 


PZE 


0,0, »♦ 


X INC TIMES 2 EXP 7 


PTTRU 


PZE 


o» *• 


X Y TIMES 2 EXP 7 


PTRND 


PZE 


*» f 0,** 


X Y FOR SCOPE 


ORF 


OCT 


233000000000 




AN 


OCT 


000000777777 




DIFX 


PZE 




FLOATING POINT X2-XI 


OIFY 


PZE 


• » 


FLOATING POINT Y2 - Yl 


KL2 


DEC 


2.0 




NNCSL 


PZE 


#» 


» FLTG PT NO INCRS 


NNCSX 


PZE 


** 


* FXD PT NO INCRS 


KL128 


DEC 


128. 


* 2EXP7 


KL1024 


DEC 


1024.0 




AN2 


OCT 


001777001777 




FX 


UFA 


ORF 






LRS 


0 






ANA 


AN 






LLS 


0 






TRA 


1,1 






END 







Y2 

MINUS Yl 



BE SET =(MAG(Y2-M)+MAG(X2-Xl))/2+l 



STORE FXD PT NO. INCRS 



STOR FLTG PT NO. INCRS 
FORM DELTA X » 2EXP7 



FORM DELTA Y • 2EXP7 
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0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
0197 
0198 
0199 
0200 
0201 
0202 
0203 
0204 
0205 
0206 
0207 
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* LINEH (709) C SUBROUTINE ) 9/29/64 LAST CARD IN DECK IS NO* 0157 

* FAP 0001 
•LINEH (709) 0002 

COUNT 150 0003 

LBL LINEH 0004 

ENTRY LINEH INXLEFT, NYLEFT, NXRITE, NOELX) 0005 

« 0006 

» ABSTRACT 0007 

« 0008 

* TITLE- LINEH (709) 0009 

* PLOT FAST HORIZONTAL LINE ON SCOPE 0010 

* 0011 
» LINEH HAS ARGUMENTS NXLEFT, NYLEFT, NXRITE, NDELX* IT 0012 
» PLOTS A HORIZONTAL LINE ON THE SCOPE WITH LEFT ENO 0013 
» COORDINATES (NX LEFT, NY LEFT), AND RIGHT END COORDINATES 0014 

* (NXRITE, NYLEFT). THE SPACING OF THE POINTS WHICH COMPRISE 0015 

* THE LINE IS NDLEX. THE LINE IS PLOTTED FROM LEFT TO RIGHT 0016 
» BY PLOTTING THE POINTS ( NXLE FT +K*NDELX, NYLEFT ) FOR K*0*lt 0017 
« 2,...,M WHERE M*NDELX IS LESS THAN OR * TO NXRI TE , AND 0018 
« !(K+1)»NDELX IS GREATER THAN NXRITE. IF =,LINE IS FINISHED* 0019 
» IF LESS, ONE MORE POINT WILL BE PLOTTED WITH COORDINATES 0020 

* (NXRITEtNYLEFT). NOTE INPUT VALUE RESTRICTIONS LISTED 0021 
» UNDER INPUTS. 0022 
» 0023 
» LANGUAGE - FAP 4 SUBROUTINE (FORTRAN II COMPATIBLE) 0024 
» EQUIPMENT - 709 WITH SCOPE 0025 
» STORAGE - 34 DECIMAL REGISTERS 0026 
» SPEED - *5+.141#(LENGTH OF LINE/PLOTTING INCREMENT) MACHINE CYCLES 0027 
» AUTHOR - J.N. GALBRAITH, MAY 10, 1962 0028 
» 0029 

* —USAGE 0030 

» 0031 

» TRANSFER VECTOR CONTAINS ROUTINES - NONE 0032 

* AND FORTRAN SYSTEM ROUTINES - NONE 0033 
» , 0034 
» FORTRAN USAGE 0035 

* CALL LI NEH INXLEFT , NYLEFT, NXRITE, NDELX) 0036 

* 0037 

* INPUTS 0038 
» 0039 

* NXLEFT IS THE X COORDINATE OF THE LEFT END OF THE LINE. 0040 
» 0041 

* NYLEFT IS THE Y COORDINATE OF THE LEFT END OF THE LINE* 0042 

* 0043 
» NXRITE IS THE X COORDINATE OF THE RIGHT END OF THE LINE* 0044 
» ABOVE COORDINATES ARE INTEGERS IN THE DECREMENT AND ARE 0045 
« ASSUMED TO BE IN SCOPE UNITS (BETWEEN 0 AND 1023) 0046 
» 0047 

* NDELX IS THE PLOTTING INCREMENT. IT DETERMINES THE SPACING OF 0048 

* THE POINTS WHICH MAKE THE LINE. A LARGE NDELX WILL 0049 
» PLOT A DOTTED LINE. NDELX AN INTEGER IN THE DECREMENT* 0050 

* 0051 

* NO POINT IS PLOTTED IF NXLEFT IS GREATER THAN NXRIT£# AND 0052 

* NO POINT IS PLOTTED IF NDELX-0 EXCEPT WHEN NXLEFT^NXRI TE* 0053 

* IN THtS CASE THE POINT (NX LEFT, NYLEFT) IS PLOTTED. NO 0054 
» ERROR INDICATORS ARE SET FOR THESE CASES AND NO CHECK IS 0055 

* MADE ON THE MAGNITUDES OF THE INPUT VALUES. QUANTITIES 0056 
« GREATER THAN 1023 ARE PLOTTED MODULO 1024. 0057 
» 0058 

* OUTPUTS 0059 

* HORIZONTAL LINE ON SCOPE. 0060 
» 0061 

* EXAMPLES 0062 

* 0063 
» 1. INPUTS - NXLEFT*0, NYLEFT-0 , NXRITE«1023, NDELX*1 0064 

* OUTPUTS - LINE ON SCOPE (LOWER LINE IN PICTURE) 0065 
» 0066 
» 2. INPUTS - NXLEFT=*0, NYLEFT= 100, NXRITE«900, NDELX=2 0067 

* OUTPUTS - LINE ON SCOPE (SECOND LINE FROM BOTTOM IN PICTURE) 0068 

* 0069 
» 3. INPUTS NXLEFT=*0, NYLEFT=200, NXRITE = 775, NDELX=3 0070 

* OUTPUTS - LINE ON SCOPE (THIRD FROM BOTTOM IN PICTURE) 0071 
» 0072 

* 4* INPUTS - NXLEFT*0, NYLEFT=300, NXRITE-650, NDELX=4 0073 
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• 




OUTPUTS • 


♦ 






* 


Dm 


T KIOl ITC 
1 INr U 1 5 


* 




OUTPUTS • 


* 






* 


6* 


INPUTS 


• 




OUTPUTS • 


• 






« 


7. 


INPUTS 


• 




OUTPUTS - 


« 






• 


8. 


INPUTS < 


• 




OUTPUTS * 


• 






• 


9. 


INPUTS 


• 




r* i iTm ire 

OUTPUTS ■ 


• 






»10. 


I rir U I 5 


• 




OUTPUTS - 


• 






*1U 


INPUTS 


* 




niiTnuTr 

OUTPUTS ' 


• 






• 




DITTIIDC 

HIL I URc 


» 






• 






• 






• 






• 






• 






• 






• 






• 






• 






• 






* 






• 






* 






• 






• 






• 






• 






* 






• 






• 






• 






• 






• 






• 







- LINE ON SCOPE (FOURTH FROM BOTTOM IN PICTURE) 

- NXLEFT*0, NYLEFT=400* NXRITE=525, NDELX=5 

- LINE ON SCOPE (FIFTH FROM BOTTOM IN PICTURE) 

- NXLEFT^O, NYLEFT=500, NXRITE=400, NDELX=6 

- LINE ON SCOPE (SIXTH FROM BOTTOM IN PICTURE) 

- NXLEFT=*0, NYLEFT=600, NXRITE=275, NDELX*7 

- LINE ON SCOPE (SEVENTH FROM BOTTOM IN PICTURE) 

- NXLEFT*0, NYLEFT=700, NXRITE*150, NDELX=8 

- LINE ON SCOPE (EIGHTH FROM BOTTOM IN PICTURE) 

- NXLEFT^O, NYLEFT=800t NXRITE=*0, N0ELX*0 

- POINT ON SCOPE (800 SCOPE UNITS UP IN PICTURE) 

- NXLEFT^O » NYLEFT=900, NXRITE=10, N0ELX=0 

- NO POINTS ON SCOPE (BLANK FILM 900 SCOPE UNITS UPI 

- NXLEFT*100, NYLEFT«1000, NXRITE*10, NDELX=1 

- NO POINTS ON SCOPE (BLANK FILM 1000 SCOPE UNITS UP! 

OF SCOPE OUTPUT APPEARS BELOW* 




0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 





PZE 








0123 




BCI 


1, LINEH 






0124 


LINEH 


SXA 


BACK, 1 






0125 




SXA 


BACK+U2 






0126 




SXD 


LINEH-2,4 






0127 




CLA* 


2,4 


Y 


COORD. 


0128 




ARS 


18 






0129 




STA 


POINT 






0130 




CLA* 


3,4 


X 


RIGHT 


0131 




SUB* 


lt4 


X 


LEFT 


0132 




TZE 


LAST 






0133 




TMI 


BACK 






0134 




POX 


,1 






0135 




CLA* 


4,4 






0136 




TZE 


BACK 






0137 




STD 


END 






0138 




STD 


INCR 






0139 




CLA* 


lt4 






0140 




STD 


POINT 






0141 




POX 


t2 






0142 


LOOP 


WTV 








0143 




CPY 


POINT 






0144 


I NCR 


TXI 


♦♦1 v 2,** 






0145 




SXD 


POINT, 2 






0146 


END 


TIX 


LOOPtl,** 






0147 




TXL 


BACK, 1,0 






0148 
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LAST 


CLA» 


3,4 




STD 


POINT 




WTV 






CPY 


POINT 


BACK 


AXT 


• »,1 




AXT 


»»,2 




TRA 


5,4 


POINT 


PZE 


0 




END 
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0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
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* LINEH (7090) (SUBROUTINE) 9/4/64 LAST CARD IN OECK IS NO. 0167 
» FAP 0001 
♦LINEH (7090) 0002 

COUNT 140 0003 

LBL LINEH 0004 

ENTRY LINEH 1NXLEFT, NYLEFT, NXRITE, NDELX) 0005 

» 0006 

* —ABSTRACT 0007 

* 0008 
» TITLE - LINEH (7090) 0009 

* PLOT FAST HORIZONTAL LINE ON SCOPE 0010 
» 0011 

* LINEH HAS ARGUMENTS NXLEFT, NYLEFT, NXRITE, NDELXJ IT 0012 

* PLOTS A HORIZONTAL LINE ON THE SCOPE WITH LEFT END 0013 
» COORDINATES ( NXLEFT , NYLEFT ) , AND RIGHT END COORDINATES 0014 

* ( NXRI TE »NYLEFT) • THE SPACING OF THE POINTS WHICH COMPRISE 0015 

* THE LINE IS NDLEX. THE LINE IS PLOTTED FROM LEFT TO RIGHT 0016 

* BY PLOTTING THE POINTS ( NXLEFT+K*NDELX, NYLEFT ) FOR K*0#1, 0017 
» 2,.i.,M WHERE M*NDELX IS LESS THAN OR « TO CNXRITE-NXLEFTI 0018 

* AND (M+1)*NDELX IS GREATER THAN ( NXR ITE-NXLEFT ) * IF *, 0019 
» LINE IS FINISHED. IF LESS, ONE MORE POINT WILL BE PLOTTED 0020 
» WITH COORDINATES (NXRITE^NYLEFT ) . NOTE INPUT VALUE 0021 
« RESTRICTIONS LISTED UNDER INPUTS. 0022 

* 0023 

* LANGUAGE - FAP » SUBROUTINE (FORTRAN II COMPATIBLE) 0024 
» EQUIPMENT - 7090 WITH SCOPE 0025 

* STORAGE - 35 DECIMAL REGISTERS 0026 

* SPEED - .5+.141MLENGTH OF L INE/PLGTT ING INCREMENT) MACHINE CYCLES 0027 

* AUTHOR - J.N. GAL8RAITH, MAY 10, 1962 0028 

* 0029 
» USAGE 0030 

* 0031 
» TRANSFER VECTOR CONTAINS ROUTINES - NONE 0032 
» AND FORTRAN SYSTEM ROUTINES - NONE 0033 

* 0034 
« FORTRAN USAGE 0035 

* CALL LINEH (NXLEFT , NYLEFT, NXRITE, NDELX) 0036 

* 0037 
» INPUTS 0038 

* 0039 
» NXLEFT IS THE X COORDINATE OF THE LEFT END OF THE LINE* 0040 

* 0041 

* NYLEFT IS THE Y COORDINATE OF THE LEFT END OF THE LINE. 0042 

* 0043 
» NXRITE IS THE X COORDINATE OF THE RIGHT END OF THE L INEw 0044 
» ABOVE COORDINATES ARE INTEGERS IN THE DECREMENT AND ARE 0045 
» ASSUMED TO BE IN SCOPE UNITS (BETWEEN 0 AND 1023) 0046 
» 0047 

* NDELX IS THE PLOTTING INCREMENT. IT DETERMINES THE SPACING OF 0048 

* THE POINTS WHICH MAKE THE LINE. A LARGE NDELX WILL 0049 

* PLOT A DOTTED LINE. NDELX AN INTEGER IN THE HECREMENT. 0050 

* NO POINT IS PLOTTED IF NXLEFT IS GREATER THAN NXRITE, AND 0051 
» NO POINT IS PLOTTED IF NDELX*0 EXCEPT WHEN NXLEFT-NXRI TE. 0052 

* IN THIS CASE THE POINT ( NXLEFT, NYLEFT ) IS PLOTTED. NO 0053 

* ERROR INDICATORS ARE SET FOR THESE CASES AND NO CHECK IS 0054 
» MADE ON THE MAGNITUDES OF THE INPUT VALUES. QUANTITIES 0055 

* GREATER THAN 1023 ARE PLOTTED MODULO 1024. 0056 

* 0057 

* OUTPUTS 0058 

* 0059 
» HORIZONTAL LINE ON SCOPE. 0060 

* 0061 

* EXAMPLES 0062 

* 0063 

* 1. INPUTS - NXLEFT*0, NYLEFT=0, NXRITE=1023, NDELX^l 0064 

* OUTPUTS - LINE ON SCOPE (LOWER LINE IN PICTURE) 0065 

* 0066 

* 2. INPUTS - NXLEF T*0, NYLEFT- 100 , NXRITE=900, NDELX-2 0067 

* OUTPUTS - LINE ON SCOPE (SECOND LINE FROM BOTTOM IN PICTURE) 0068 

* 0069 

* 3. INPUTS - NXLEFT^O, NYLEFT=200, NXRITE=*775, NDELX=3 0070 

* OUTPUTS - LINE ON SCOPE (THIRD FROM BOTTOM IN PICTURE) 0071 
» 0072 

* 4. INPUTS - NXLEFT^O, NYLEFT=300, NXRITE=650, NDELX*4 0073 
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• 




OUTPUTS 


• 






• 


5. 


INPUTS 


• 




OUTPUTS 


• 






• 


6. 


INPUTS 


• 




OUTPUTS 


* 






• 


7. 


INPUTS 


• 




OUTPUTS 


• 






• 


8. 


INPUTS 


• 




OUTPUTS « 


* 






• 


9. 


INPUTS 


* 




OUTPUTS 


• 






•10. 


INPUTS 


• 




OUTPUTS 


• 






•11. 


INPUTS • 


• 




OUTPUTS 


• 






• 




PICTURE 


• 






* 






• 






• 






• 






• 






• 






• 






• 






• 






• 






* 






• 






• 






• 






• 






• 






• 






• 






• 






* 






« 






« 






* 






* 






• 






• 






• 







- LINE ON SCOPE (FOURTH FROM BOTTOM IN PICTURE) 

- NXLEFT=*0, NYLEFT-400, NXRITE=525, NDELX=5 

- LINE Oft SCOPE (FIFTH FROM BOTTOM IN PICTURE) 

- NXLEFT*0, NYLEFT=500, NXRITE»400, NDELX*6 

- LINE ON SCOPE (SIXTH FROM BOTTOM IN PICTURE ) 

- NXLEFT*0, NYLEFT=60Q, NXRITE=275, NDELX-7 

- LINE ON SCOPE (SEVENTH FROM BOTTOM IN PICTURE) 

- NXLEFT*0, NYLEFT=700, NXRITE*150, NDELX=8 

- LINE ON SCOPE (EIGHTH FROM BOTTOM IN PICTURE) 

- NXLEFT^O, NYLEFT=800, NXRITE=0» NOELX=0 

- POINT EN SCOPE (800 SCOPE UNITS UP IN PICTURE) 

- NXLEFT^O, NYLEFT=900, NXRITE'10, NDELX-0 

- NO POINTS ON SCOPE (BLANK FILM 900 SCOPE UNITS UP) 

- NXLEFT^lOO, NYLEFT*1000, NXRITE=10, NDELX=1 

- NO POINTS ON SCOPE (BLANK FILM 1000 SCOPE UNITS UP) 

OF SCOPE OUTPUT APPEARS BELOW. 




* PROGRAM FOLLOWS BELOW 
* 

* FOLLOWING CARD DESIGNATES THE DATA CHANNEL THAT CRT IS ATTACHED TO. 

* TO CHANGE, ALTER THE LETTER DESIGNATION ONLY, AND REASSEMBLE* 



LINEH 



0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 



TAPENO 


Dl 






0130 


EQU 


X-105 






0131 


PZE 








0132 


BCI 


1, LINEH 






0133 


SXA 


BACK.1 






0134 


SXA 


BACK+1#2 






0135 


SXD 


LINEH-2,4 






0136 


CLA« 


2,4 


Y 


COORD. 


0137 


ARS 


18 






0138 


STA 


POINT 






0139 


CLA* 


3,4 


X 


RIGHT 


0140 


SUB» 


1,4 


X 


LEFT 


0141 


TZE 


LAST 






0142 


TMI 


BACK 






0143 


PDX 


,1 






0144 


CLA» 


4,4 






0145 


TZE 


BACK 






0146 


STD 


END 






0147 


STD 


INCR 






0148 
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CLA* 


It* 


0149 




STD 


POI NT 


0150 




PDX 


♦ 2 


0151 


LOOP 


WRS 


SCPAD 


0152 




RCHX 


10 


0153 


I NCR 


TXI 


2t*» 


0154 




SXO 


P0INT t 2 


0155 


END 


TIX 


LOOP* 1 t *» 


0156 




TXL 


BACK* 1 tO 


0157 


LAST 


CLA» 


3,4 


0158 




STO 


POINT 


0159 




WRS 


SCPAD 


0160 




RCHX 


10 


0161 


BACK 


AXT 


**,1 


0162 




AXT 


***2 


0163 




TRA 


5,4 


0164 


POINT 


PZE 


0 


0165 


10 


IOCO 


P0INT,0,1 


0166 




END 




0167 
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* LINEV (709) (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO* 0160 
» FAP 0001 
•LINEV (709) 0002 

COUNT 150 0003 

LBL LINEV 0004 

ENTRY LINEV (NXBOT, NYBOT, NYTOPt NDELY) 0005 

* 0006 
, — — ABSTRACT 0007 

* 0008 

* TITLE - LINEV (709) 0009 

* PLOT FAST VERTICAL LINE ON SCOPE 0010 
» 0011 
» LINEV HAS ARGUMENTS NXBOT, NYBOT, NYTOP* NDELY. IT PLOTS A 0012 

* VERTICAL LINE ON THE SCOPE WITH BOTTOM COORDINATES 0013 

* (NXBOT, NYBOT), AND TOP COORDINATES CNXBOT, NYTOP J. THE 0014 
» SPACING OF THE POINTS WHICH COMPRISE THE LINE IS NDELY* 0015 
» THE LINE IS PLOTTED FROM BOTTOM TO TOP BY PLOTTING THE 0016 

* POINTS INXBOT, NYBOT+K»NDELY ) FOR K=0, 1,2, . *.,M WHERE 0017 

* M«NDELY IS LESS THAN OR = TO NYTOP, AND ( M+l )*NOELY IS 0018 
» GREATER THAN NYTOP. IF = , LINE IS FINISHED. IF LESS, ONE 0019 
» MORE POINT WILL BE PLOTTED WITH COORDINATES (NXBOT|NYTOP). 0020 

* NOTE INPUT VALUE RESTRICTIONS LISTED UNDER INPUTS. 0021 

* 0022 

* LANGUAGE - FAPI SUBROUTINE (FORTRAN II COMPATIBLE) 0023 
» EQUIPMENT - 709 WITH SCOPE 0024 
» STORAGE - 34 DECIMAL REGISTERS 0025 

* SPEED - .5+.141#(LENGTH OF LINE/PLOTTING INCREMENT) MILLISECONDS 0026 

* AUTHOR - J.N. GALBRAITH , MAY 10, 1962 0027 
» 0028 

* USAGE 0029 

* 0030 
» TRANSFER VECTOR CONTAINS ROUTINES - NONE 0031 

* AND FORTRAN SYSTEM ROUTINES - NONE 0032 
» 0033 
» FORTRAN USAGE 0034 
» CALL LI NEV (NXBOT , NYBOT , NYTOP, NDELY) 0035 

* 0036 

* INPUTS 0037 

* 0038 
» NXBOT IS THE X COORDINATE OF THE BOTTOM OF THE LINE 0039 

* 0040 

* NYBOT IS THE Y COORDINATE OF THE BOTTOM OF THE LINE 0041 
» 0042 

* NYTOP IS THE Y COORDINATE OF THE TOP OF THE LINE 0043 

* ABCVE COORDINATES ARE INTEGERS IN THE DECREMENT 0044 

* AND ARE ASSUMEO TO BE IN SCOPE UNITS (BETWEEN 0045 

* ZERO AND 1023 DECIMAL) 0046 

* 0047 

* NDELY IS THE PLOTTING INCREMENT. IT DETERMINES THE SPACING OF 0048 

* THE POINTS WHICH MAKE THE LINE. A LARGE NDELY WILL PLOT 0049 
» A DOTTED LINE. NDELY IS AN INTEGER IN THE DECREMENT. 0050 
» NO POINT IS PLOTTED IF NYBOT IS GREATER THAN NYTOP, AND 0051 
» NO POINT IS PLOTTED IF NDELY*0 EXCEPT WHEN NYTQP*NYBOT. 0052 

* IN THIS CASE THE POINT ( NXBOT, NYBOT) IS PLOTTED. NO ERROR 0053 

* INDICATORS ARE SET FOR THESE CASES AND NO CHECK IS MADE 0054 
» ON THE MAGNITUDES OF THE INPUT VALUES. QUANTITIES GREATER 0055 

* THAN 1023 ARE PLOTTED MODULO 1024. 0056 

* 005 7 

* OUTPUTS 0058 

* VERTICAL LINE ON SCOPE. 0059 

* 0060 

* EXAMPLES 0061 

* 0062 

* I. INPUTS - NYBCT=0, NXBOT=0, NYT0P*1023, NOELY-1 0063 
« OUTPUTS - LINE ON SCOPE (LEFT-MOST IN PICTURE) 0064 
» 0065 

* 2. INPUTS - NYBOT=0 , NXB0T=100, NYTOP-900, NDELY*2 0066 
» OUTPUTS - LINE OK SCOPE (SECOND FROM LEFT IN PICTURE) 0067 
» 0068 

* 3. INPUTS - NYBOT^O, NXB0T=200, NYT0P=775, NDELY=3 0069 

* OUTPUTS - LINE ON SCOPE (THIRD FROM LEFT IN PICTURE) 0070 

* 0071 
« 4. INPUTS ~ NYBOT-Q + NX80T=300, NYTOP-650, NDELY-4 0072 

* OUTPUTS - LINE ON SCOPE (FOURTH FROM LEFT IN PICTURE) 0073 

* 0074 
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* 


c 

D* 


T MDI ITC 


* 




ni irm it c 

OUTPUTS 


* 






* 


c. 
o. 


T MDI IT C 
1 INK U 1 O 


* 




OUTPUTS 


* 






• 


7. 


I NPUTS 


• 




r>l ITT rtl ITT 

OUTPUTS 


• 






* 


8. 


r MDI ITC 


• 




OUTPUTS 


* 






* 


9. 


I NPUTS 


• 




flJ ITDI IT C 

UU 1 PU f s 


• 






• 10. 


I NPUTS 


• 




n 1 ITO 1 IT c 

UU 1 rU l S 


• 






•11. 


I NPUTS 


• 




ni ITOllTC 

UU irU I 5 


• 






• 




PICTURE 


• 






» 






• 






• 






» 






• 






* 






• 






• 






• 






* 






• 






• 






• 






• 






* 






• 






• 






• 






• 






• 






• 






• 






* 






• 






• 






• 






* 






• 







• NYBGT^G, NXB0T*400, NYTOP=525, NDELY*5 

• LINE ON SCOPE (FIFTH FROM LEFT IN PICTURE) 

- NYB0T=0, NXB0T*500, NYT0P- 400, NDELY=6 

• LINE ON SCOPE (SIXTH FROM LEFT IN PICTURE) 

• NYB0T=0, NXB0T*600, NYT0P=275, N0ELY-7 

• LINE Ofc SCOPE (SEVENTH FROM LEFT IN PICTURE) 

• NYB0T=0, NXB0T=700, NYT0P=150, NDELY=8 

- LINE ON SCOPE (EIGHTH FROM LEFT IN PICTUREI 

• NYB0T=0, NXB0T=800, NYTOP=0, NDELY=0 

• POINT ON SCOPE (800 SCOPE UNITS FROM LEFT IN PICTURE) 
■ NYB0T=0, NXB0T=900, NYT0P=10, NDELY«0 

- NO POINTS ON SCOPE (BLANK FILM 900 SCOPE UNITS FROM LEFT! 

• NYB0T=100, NXB0T=1000, NYT0P»10, NDELY*0 

- NO POINTS ON SCOPE ( BLANK FILM 1000 SCOPE UNITS FROM LEFT! 
OF SCOPE OUTPUT APPEARS BELOW. 




0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 





PZE 






0126 




BCI 


1 f LINEV 




0127 


LINEV 


SXA 


BACK* I 




0128 




SXA 


BACK+W2 




0129 




SXO 


LINEV-2,4 




0130 




CLA* 


1,4 


X COORD. 


0131 




STD 


POINT 




0132 




CLA* 


3,4 


YTOP 


0133 




SUB* 


2,4 


YBOT 


0134 




TZE 


LAST 




0135 




TMI 


BACK 




0136 




PDX 


,1 




0137 




CLA* 


4,4 


DELTA 


0138 




TZE 


BACK 




0139 




STD 


END 




0140 




sro 


INCR 




0141 




CLA* 


2,4 




0142 




PDX 


t2 




0143 




SXA 


POINT, 2 




0144 


LOOP 


WTV 






0145 




CPY 


POINT 




0146 


I NCR 


TXI 


*+l»2,#* 




0147 




SXA 


POINT, 2 




0148 


END 


TIX 


L0iP,l,*» 




0149 
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TXL 


BACK, 


CLA» 


3,4 


ARS 


18 


STA 


POINT 


WTV 




CPY 


POINT 


AXT 




AXT 


»»,2 


TRA 


5,4 


PZE 


0 


END 
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0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
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• LINEV (7090) (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO. 0168 

• FAP 0001 
•LINEV (7090) 0002 

COUNT 140 0003 

LBL LINEV 0004 

ENTRY LINEV iNXBOT, NYBOT, NYTOP, NDELY) 0005 

» 0006 

• —ABSTRACT 0007 

• 0008 
» TITLE - LINEV (7090) 0009 

• PLOT FAST VERTICAL LINE ON SCOPE 0010 

• 0011 

• LINEV HAS ARGUMENTS NX80T, NYBOT* NYTOP* NDELY. IT PLOTS A 0012 

• VERTICAL LINE ON THE SCOPE WITH BOTTOM COORDINATES 0013 
» (NXBOTf NYBOT), AND TOP COORDINATES (NXBOT, NYTQPI • THE 0014 

• SPACING OF THE POINTS WHICH COMPRISE THE LINE IS NDELY. 0015 

• THE LINE IS PLOTTED FROM BOTTOM TO TOP BY PLOTTING THE 0016 

• POINTS INXBOT ♦ NYBOT+MNDELY ) FOR K=0, 1, 2t . ^*,M WHERE 0017 

• M»NDELY IS LESS THAN OR * TO ( NYTOP— NYBOT ) » AND 0018 

• (M+1MNDELY IS GREATER THAN ( NYTOP-NYBOT ) . IF LINE IS 0019 
» FINISHED. IF LESS, ONE MORE POINT WILL BE PLOTTED WITH 0020 

• COORDINATES ( NXBOT , NYTOP ) . NOTE INPUT VALUE RESTRICTIONS 0021 
» LISTED UNDER INPUTS. 0022 

• 0023 

• LANGUAGE - FAP* SUBROUTINE (FORTRAN II COMPATIBLE) 0024 
» EQUIPMENT - 7090 WITH SCOPE 0025 

• STORAGE - 35 DECIMAL REGISTERS 0026 

• SPEED - .5+.141#(LENGTH OF LINE/PLOTTING INCREMENT) MILL I SECONDS 0027 
» AUTHOR - J.N. GALBRAITH , MAY 10, 1962 0028 

• 0029 

• —USAGE 0030 

» 0031 

» TRANSFER VECTOR CONTAINS ROUTINES - NONE 0032 

• AND FORTRAN SYSTEM ROUTINES - NONE 0033 
» 0034 

• FORTRAN USAGE 0035 

• CALL LI NEV( NXBOT , NYBOT, NYTOP, NDELY) 0036 

• 0037 

• INPUTS 0038 
» 0039 
» NXBOT IS THE X COORDINATE OF THE BOTTOM OF THE LINE 0040 

• 0041 

• NYBOT IS THE Y COORDINATE OF THE BOTTOM OF THE LINE 0042 

• 0043 
» NYTOP IS THE Y COORDINATE OF THE TOP OF THE LINE 0044 

• ABOVE COORDINATES ARE INTEGERS IN THE DECREMENT 0045 

• AND ARE ASSUMED TO BE IN SCOPE UNITS (BETWEEN 0046 

• ZERO AND 1023 DECIMAL) 0047 

• 0048 
» NDELY IS THE PLOTTING INCREMENT. IT DETERMINES THE SPACING OF 0049 

• THE POINTS WHICH MAKE THE LINE. A LARGE NDELY WILL PLOT 0050 

• A DOTTED LINE. NDELY IS AN INTEGER IN THE DECREMENT. 0051 

• NO POINT IS PLOTTED IF NYBOT IS GREATER THAN NYTOP, AND 0052 
» NO POINT IS PLOTTED IF NDELY«0 EXCEPT WHEN NYT0P*NYBOT. 0053 
» IN THIS CASE THE POINT (NXBOT, NYBOT) IS PLOTTEH. NO ERROR 0054 

• INDICATORS ARE SET FOR THESE CASES AND NO CHECK IS MADE 0055 
» ON THE MAGNITUDES OF THE INPUT VALUES. QUANTITIES GREATER 0056 

• THAN 1023 ARE PLOTTED MODULO 1024. 0057 

• 0058 
» OUTPUTS 0059 
» 0060 
» VERTICAL LINE ON SCOPE. 0061 

• 0062 

• EXAMPLES 0063 
» 0064 

• 1. INPUTS - NYBOT=0 , NXBOT=0, NYT0P=1023, NDELY«1 0065 

• OUTPUTS - LINE ON SCOPE (LEFT-MOST IN PICTURE) 0066 

• 0067 

• 2. INPUTS - NYBOT^O, NXBOT^lOO, NYT0P=900, NDELY=2 0068 
» OUTPUTS - LINE ON SCOPE (SECOND FROM LEFT IN PICTURE) 0069 

• 0070 

• 3. INPUTS - NYBOT^O, NXB0T=200, NYT0P=775, NDELY=3 0071 
» OUTPUTS - LINE ON SCOPE (THIRD FROM LEFT IN PICTURE) 0072 

• 0073 

• 4. INPUTS - NYBOT=0, NXBOT=300, NYT0P*650, NDELY=4 0074 
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» 5. 
* 

• 6. 

* 7. 

* 8. 

* 

» 9. 

• 10, 

•n. 



OUTPUTS - LINE ON SCOPE ( FOURTH FROM LEFT IN PICTURE I 

INPUTS - NYB0T=0, NXB0T=400, NYT0P=525, NDELY=5 
OUTPUTS - LINE OR SCOPE (FIFTH FROM LEFT IN PICTURE) 

INPUTS - NYBOT^G, NXB0T=500, NYTOP* 400, NDELY=6 
OUTPUTS - LINE ON SCOPE (SIXTH FROM LEFT IN PICTURE) 

INPUTS - NYBOT=G, NXBOT=600, NYT0P=275, NDELY*7 
OUTPUTS - LINE ON SCOPE (SEVENTH FROM LEFT IN PICTURE) 

INPUTS - NYBOT-O, NXBOT=700, NYTOP=150, NDELY*8 
OUTPUTS - LINE ON SCOPE (EIGHTH FROM LEFT IN PICTURE* 

INPUTS - NYB0T=0, NXBQT=800, NYTOP=0, NDELY^O 

OUTPUTS - POINT CN SCOPE (800 SCOPE UNITS FROM LEFT IN PICTURE) 
INPUTS - NYBOT=0, NXB0T-900 f NYT0P=10, NOELY=0 

OUTPUTS - NO POINTS CN SCOPE (BLANK FILM 900 SCOPE UNITS FROM LEFT) 
INPUTS - NYB0T=100, NXB0T=1000, NYTOP=10, NDELY*0 

OUTPUTS - NO POINTS ON SCOPE ( BLANK FILM 1000 SCOPE UNITS FROM LEFT) 
PICTURE OF SCOPE OUTPUT APPEARS BELOW. 




* PROGRAM FOLLOWS BELOW 

* FOLLOWING CARD DESIGNATES THE OATA CHANNEL THAT CRT IS ATTACHED TO. 
» TO CHANGE, ALTER THE LETTER DESIGNATION ONLY, AND REASSEMBLE* 

X 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 



TAPENO 


Dl 




0131 


EQU 


X-105 




0132 


PZE 






0133 


BCI 


1, LINEV 




0134 


SXA 


BACK,1 




0135 


SXA 


BACK+1,2 




0136 


SXD 


LINEV-2,4 




0137 


CLA* 


lt4 


X COORD. 


0138 


STD 


POINT 




0139 


CLA* 


3,4 


YTOP 


0140 


SUB» 


2,4 


Y80T 


0141 


TZE 


LAST 




0142 


TMI 


BACK 




0143 


PDX 


,1 




0144 


CLA* 


4,4 


DELTA 


0145 


TZE 


BACK 




0146 


STD 


END 




0147 


STD 


INCR 




0148 


CLA* 


2,4 




0149 
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POX 


t *- 


ul !>U 




SXA 


rUl IN 1 f C 




LGGf* 


MRS 


SCPAD 






RCHX 


1 0 


ill 


t sir Q 


TVT 
1 A 1 


♦■♦■I 1 2 1 ** 


fll *>A. 




C y A 
J A A 


r U 1 IN 1 ft. 


Oi cc 
UiDD 


CiNU 


TIV 
1 1 A 


i nno i * » 


U 1 DO 




t yi 

1 Al_ 


D A V, IV f lfU 


U ID 1 


LAST 


CLA» 


J t *T 


0158 




ARS 


18 


0159 




STA 


POINT 


0160 




WRS 


SCPAD 


0161 




RCHX 


10 


0162 


BACK 


AXT 


**t I 


0163 




AXT 


»♦ f 2 


0164 




TRA 


5,4 


0165 


POINT 


PZE 


0 


0166 


10 


IOCD 


P0INT,0,1 


0167 




END 




0168 
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» LINTR1 * * L1NTR1 * 
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• LINTR1 (SUBROUTINE) 

• LABEL 
CLINTR1 

* SUBROUTINE t INTRU X, XLO, DELX , TABLE, NTABLE.YOFX) 

C 

C -—ABSTRACT 

C 

C TITLE - LINTR1 - 



9/29/64 LAST CARD IN DECK IS NO. 



LINEAR INTERPOLATION IN A TABLE 

LINTR1 INTERPOLATES LINEARLY IN A TABLE TO FIND A VALUE 
WHICH LIES BETWEEN THE TABULATEO VALUES. XLO IS THE 
ARGUMENT CORRESPONDING TO THE LOWEST TABULATED VALUE* DELX 
IS THE ARGUMENT DIFFERENCE 8ETWEEN TABULAR VALUES. 
THE TABLE IS LOCATED IN TABLE C I ) • X IS THE ARGUMENT AND 
YOFX IS THE INTERPOLATED VALUE. HENCE 



C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

C LANGUAGE 
C EQUIPMENT 
C STORAGE 
C SPEED 
C AUTHOR 
C 
C 
C 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 
C AND FORTRAN SYSTEM ROUTINES - NONE 

C 

C FORTRAN USAGE 

C CALL LINTR1 (X,XLO,DELX, TABLE » NT ABLE, YOFX ) 



XTRA 



YOFX = TABLE ( L ) + ( TABLE (L+ I) - TABLECL ) ) * 

DELX 

WHERE L IS SUCH THAT 

XLO+(L~l)*DELX LSTHN= X LSTHN XLO+L»DELX 
AND XTRA = X-XLO-(L-l)»DELX 

DELX IS CONSTRAINED TO BE POSITIVE 
X MUST LIE IN THE ARGUMENT RANGE OF THE TABLE. 



- FORTRAN II SUBROUTINE 
709 OR 7090 (MAIN FRAME ONLY) 

- 96 REGISTERS 



- S. M. 



SIMPSON 

USAGE 



XLO 



DELX 



TABLE! I) 



NTABLE 



C INPUTS 
C 

C X 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 

C OUTPUTS 
C 

C YOFX 
C 

C EXAMPLES 
C 

C 1. INPUTS 
C 

C OUTPUTS 
C 

C 2. INPUTS 
C OUTPUTS 
C 

C 3. INPUTS 
C OUTPUTS 
C 



IS ARGUMENT FOR WHICH INTERPOLATION IS DESIRED. 
XLO LSTHN OR = X LSTHN OR = XLO+( NTABLE-1 )*DELX. 

IS THE ARGUMENT CORRESPONDING TO THE FIRST TABULAR 
ENTRY. 

IS THE ARGUMENT DIFFERENCE BETWEEN TWO SUCCESSIVE 
TABULAR ENTRIES. 

MUST EXCEED 0.0, BUT THIS CONSTRAINT IS NOT CHECKED* 

1 = 1. ..NTABLE IS A GIVEN ARRAY IN WHICH TABLE ( J I 
CONTAINS Y(XL0+DELX*(J-1)). 

IS THE LENGTH OF THE TABLE. 



WILL CONTAIN THE LINEARLY INTERPOLATED VALUE 



X=7.5 XL0=5. DELX*2.5 TABLE ( 1...9)a*l.*4«,9., 

16., 25., 36. ,49., 64., 81. NTABLE=9 

Y0FX=4. 



SAME AS EXAMPLE 1, 
Y0FX=56.8 



SAME AS EXAMPLE 1, 
Y0FX=81. 



EXCEPT X=21.3 
EXCEPT X=25. 



0092 
0001 
0G02 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0016 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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• LINTR1 * # tINTRl * 

•••••**••**•••*»*•**•*•# *•*«*••#*•**•«****•**•** 

iPAGE 2) { PAGE 2) 

C 4. INPUTS - SAME AS EXAMPLE I. EXCEPT X=13. 0075 

C OUTPUTS - Y0FX=17.8 0076 

C 0077 

DIMENSION TABLE ( 2 ) 0078 

C SET UP. 0079 

XMXLO*X-XLO 0080 

20 ILO=XMXLO/DELX+i.O 0081 

C INTERPOLATE ONLY IF ILO DOESNT CORRESPOND TO LAST TABULAR ENTRY. 0082 

IF ( ILO— NTABLE) 30,40,30 0083 

30 FLIL0=IL0-1 0084 

DIFX=XMXLO-FLIL0*DELX 0085 

IHI-IL0+1 0086 

YOFX* TABLE! ILO)-MTABLE( IHI )-TABLE( ILO) )*DIFX/DELX 0087 

GO TO 9999 0088 

40 YOFX*TABLE( NTABLE) 0089 

GO TO 9999 0090 

9999 RETURN 0091 

END 0092 



» LISTNG « 
••••«•*•»•»*•••*•••»•»«• 



PROGRAM LISTINGS 



*•**»*•**••••«**«••#•**• 

# LISTNG ♦ 



9/29/64 LAST CAftD IN OECK IS NO* 



f— ABSTRACT 

TITLE - LISTNG 

LIST AUXILIARY INFORMATION FOR A INDATA-OUDATA TYPE TAPE 

LISTNG REWINDS A SPECIFIED TAPE* WRITES THE RECORD NUMBER, 
LENGTH OF DATA, AND AUXILIARY INFORMATION, AND CHECKS THE 
SUMCHECK FOR EACH RECORD ON THE TAPE, AND THEN REWINDS 
THE TAPE AGAIN. SEE THE WRITE-UP FOR OUOATA FOR A 
DESCRIPTION OF THE FORMAT OF THE TAPE. 

THE RECORD NUMBER AND AUXILIARY INFORMATION ARE 
INTERPRETED AS FLOATING POINT, FIXED POINT, OCTAL, AND 
HOLLERITH. THE HOLLERITH PRINT-OUT IS SUPPRESSED IF 
ILLEGAL CHARACTERS ARE PRESENT. 



LANGUAGE 

EQUIPMENT 

STORAGE 

SPEED 

AUTHOR 



FORTRAN II SUBROUTINE 

709 OR 7090 C MAI N FRAME, DATA CHANNEL) 
755 REGISTERS 



- R.A» WIGGINS 



NOV. 



1962 



— — USAGE 



TRANSFER VECTOR CONTAINS ROUTINES 
AND FORTRAN SYSTEM ROUTINES 



FORTRAN USAGE 

CALL LISTNG( IT APE, JT APE, DATA) 



FAPSUM, SAME, XSAMEf FSHIP, SHFTR2 
(FIL),(RLR)»(RWT),(SPH),ft STHi , 
(TSB) 



» LISTNG (SUBROUTINE) 

» LABEL 
CLISTNG 

SUBROUTINE LISTNG UTAPE, JTAPE, DATA) 

C 
C 
C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

Cil 111111122222222223333333333444444444455555555556666666666777777777788 
C1234567890123456 7890123456789012345678901234567890123456789012345678901 
C 

C (PAGE 1 CONTAINS) 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 



INPUTS 



I TAPE 



JTAPE 



DATA ( I } 



IS LOGICAL TAPE NUMBER FOR THE TAPE THAT IS TO BE LISTED^ 
IS FORTRAN II INTEGER. 

IS LOGICAL TAPE NUMBER FOR OUTPUT TAPE 

(LISTNG DOES NOT REWIND THIS TAPE BEFORE OR AFTER 
OUTPUT) 

1=1, N IS A BUFFER FOR TEMPORARY USE BY LISTNG* 
N MUST BE GREATER THAN THE LONGEST DATA SERIES ON THE 
TAPE. 



OUTPUTS 



THE OUTPUT IS A LISTING OF THE TAPE AS SHOWN IN THE EXAMPLE 
NOTE THAT ONLY THE FIRST 50 WORDS OF EACH AUXILIARY 
INFORMATION IS PRINTED. 



EXAMPLES 



EXAMPLES FOR OUDATA LOADED ON LOGICAL UNIT 9. 
DIMENSION DATA(iOOOO) 
CALL LISTNG (9, 2, DATA) 
OUTPUTS - WRITTEN ON LOGICAL TAPE NO. 2 



USAGE 



THIS IS A LISTING OF THE AUXILIARY INFORMATION AND STATISTICS FOR AN 
((INDATA-OUDATA)) TYPE TAPE 

(PAGE 2 CONTAINS) 



FILE 



1 CONTAINS 



RECORD NO. 



-74852 (INTERPRETED AS AN INTEGER ) 
.051516E 06 (INTERPRETED AS FLOATING POINT ) 



0220 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 



•••»#•««**»*•••*»**••••* 
• LISTNG * 
•«•*•••*•#•••*•»*»#***** 
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#***•»*•***» 

* LISTNG 
***«»*****«• 



•«•***••*»** 



»***•****»» 

(PAGE 2) 



622144474325 (INTERPRETED AS OCTAL ) 

SAMPLE (INTERPRETED AS ALPHANUMERIC) 



LENGTH OF AUXILIARY INFORMATION BLOCK IS 

NUMBER OF DATA POINTS IS 3 

NUM8ER OF DATA POINTS STORED PER REGISTER IS 



FLOATING 



FIXED 



OCTAL 



ALPHANUMERIC 



(PAGE 3 CONTAINS) 



FILE 2 CONTAINS 



RECORD NO. 



WITH TITLE 



3 (INTERPRETED AS AN INTEGER) 
0.001722E-38 (INTERPRETED AS FLOATING POINT) 
000003000000 (INTERPRETED AS OCTAL) 

003000 (INTERPRETED AS ALPHANUMERIC) 

SAMPLE INDATA-OUDATA TYPE TAPE RECORD 



IS 



LENGTH OF AUXILIARY INFORMATION BLOCK 
NUMBER OF DATA POINTS IS 3 
NUMBER OF DATA POINTS STORED PER REGISTER IS 



21 



FLOATING 



FIXED 



OCTAL 



ALPHANUMERIC 



10 



15 



16 



18 



20 
30 



200 
210 



215 



225 



0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 



DELTAT 


0.49999999E- 


•01 


63897 


174631463146 




0101 
0102 


RDAY 


0J01721915E-38 


30 


000036000000 




0103 














0104 


RUNITS 


-0.16497062E-28 


-18003 


443123514645 


MICRON 


0105 














0106 


TITLE 


-0.48000000E 


02 


-68992 


606600000000 


SAMPL 


0107 




0.03516110E 


14 


89113 


256031452421 


E INDA 


0108 




-0.12662410E 


08 


-78944 


632140466424 


TA-OUD 


0109 




0.67124052E 


04 


72913 


216321606370 


ATA TY 


0110 




-0.61013036E- 


-21 


-30064 


472560632147 


PE TAP 


0111 




0.05680751E 


14 


89192 


256051252346 


E RECO 


0112 




-0.33042351E- 


-16 


-38192 


512460606060 


RD 


0113 




-0^06095237E 


02 


-68656 


606060606060 




0114 



0115 

DIMENSION DATA(IOOOO) 0116 

DEFINE THE MAXIMUM NUMBER OF ELEMENTS TO BE PRINTED IN AUX. INFOi 0117 

MA = 50 0118 

DEFINE THE PRINTED OUTPUT TAPE NO. 0119 

N = JTAPE 0120 

REWIND ITAPE 0121 

ERR=0. 0122 

WRITE OUTPUT TAPE N,10 0123 
FORMAT ( 97H1THI S IS A LISTING OF THE AUXILIARY INFORMATION AND STAT 0124 

1ISTICS FOR AN ( I INDATA-OUDATA) ) TYPE TAPE) 0125 

IFILE=1 0126 

READ TAPE ITAPE* IRECNO, LAUXBK,NOPTS,MODCOD, SCALE 0127 

IF(IRECNO) 18,16,18 0128 

CONTINUE 0129 

REWIND ITAPE 0130 

RETURN 0131 

READ TAPE I T APE* ( DATA ( I ) , 1= 1 ,LAUXBK ) 0132 

CALL FAPSUM ( L AUX BK-1, DATA, SUMCK ) 0133 

IF ( SUMCK— DAT A( L AUX BK ) ) 20,30,20 0134 

ERR^l. 0135 

CONTINUE 0136 

Jl = 1 0137 

TES ■ SAMEFIIRECNO) 0138 

GO TO 5000 0139 

WRITE OUTPUT TAPE N, 210, IFILE, I RECNO, IRECNO, IRECNO, IRECNO 0140 
F0RMAT(5H1FIL£,I4,9H CONT A I NS//5X 1 IHRECORD NO. 114, 28H (INTERPRETE 01'. 1 
ID AS AN INTEGER)/16XE14.6,32H (INTERPRETED AS FLOATING P0INTJ/16X0 0142 
214, 23H (INTERPRETED AS OCTAL ) /24XA6, 30H (INTERPRETED AS ALPHANUMER 0143 

3IO) 0144 

GO TO 225 0145 

WRITE OUTPUT TAPE N, 210, IFILE, IRECNO, IRECNO, IRECNO 0146 

SCAN FOR TITLE 0147 

T * 5HTITLE 0148 



•••••••••»••••••*»•••••• PROGRAM 

• LI STNG ♦ 
«***••«*••*•*******•*••* 

(PAGE 3) 



LI STINGS ««*•»«•*»•••* •**••»* 

# LI STNG • 
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(PAGE 3) 



L»l 0149 

35 IF (DATA(L) ) 40*80,40 0150 

40 IF(DATAU)-T) 50,60,50 0151 

50 L-L+2+ XSAMEF (DATA ( L+l ) ) 0152 

GO TO 35 0153 

60 IMIN=L+2 0154 

IMAX*L+1+XSAMEFIDATA(L+1)3 0155 

WRITE OUTPUT TAPE N,70, ( DATA( I),I~IMIN,IMAX) 0156 

70 FORMAT ( 15H0 WITH TITLE5X12A6*) 0157 

C EITHER NO TITLE FOUND, OR TITLE FOUND AND PRINTED 0158 

80 CONTINUE 0159 

C PRINT INFORMATION ABOUT DATA 0160 

220 WRITE OUTPUT TAPE N,230,LAUXBK,N0PTS,M0DC0D 0161 

230 FORMAT ( 4 1H0LENGTH OF AUXILIARY INFORMATION BLOCK IS, 0162 
II6/25H NUMBER OF DATA POINTS IS,I6/45H NUMBER OF DATA POINTS Sf ORE 0163 
2D PER REGISTER IS, I6//23X8HFL0AT ING7X5HF I XED7X5H0CTAL4X12HALPHANUM 0164 

3ERIC) 0165 

C PRINT AUX INFO. (ONLY FIRST MA ELEMENTS IF A VECTOR) 0166 

L=l 0167 

90 IF (DATA( L) ) 100,150,100 0168 

100 Jl * 2 0169 
TES = DATA ( L+2 ) 0170 
GO TO 5000 0171 

310 WRITE OUTPUT TAPE N, 101, DAT A( L ) , DAT A( L+2 ) , DATA( L+2 ) ,DATA( L+21 , 0172 

1 DATA ( L+2 ) 0173 

101 FORMAT (1H03XA6,5XE18. 8, I9,015,4XA6) 0174 
GO TO 330 0175 

320 WRITE OUTPUT TAPE N, 101, DAT A< L ), DAT A( L+2) , DATA ( L+2 ) ,DATA(L*21 0176 

330 IF ( XSAMEF ( DATAiL+ 1) )-i ) 140,140,340 0177 

340 IMIN = L+3 0178 

IMAX=XMIN0F(MA,XSAMEF(DATA(L+1) ) ) + L+l 0179 

Jl * 3 0180 

DO 108 J=IMIN,IMAX 0181 

TES * DATA(J) 0182 

GO TO 5000 0183 

360 WRITE OUTPUT TAPE N, 1 10 , DATA ( J ) , DAT A( J ) , DATA( J ) , DATA ( J ) 0184 

110 F0RMATU5XE18. 3*19, 015, 4XA6) 0185 

GO TO 108 0186 

370 WRITE OUTPUT TAPE N, 1 10, DAT A( J ) , DATA( J ) , DATA ( J ) 0187 

108 CONTINUE 0188 

IF ( XSAMEF (DATA ( L+l ))~MA) 140,140, 120 0189 

120 WRITE OUTPUT TAPE N, 130, ( DATA(L+1) ) 0190 

130 F0RMAT(1H025X4HETC,I6,8H IN ALL.) 0191 

140 L*L+2+ XSAMEF (DAT A< L+l ) ) 0192 

GO TO 90 0193 

150 CONTINUE 0194 

C AUXILIARY INFO IS LISTED 0195 

IF (ERR ) 160,159,160 0196 

155 NN=(N0PTS+MGDC0D-1)/M0DC0D +1 0197 

READ TAPE I TAPE,* ( DATA( I ) » I = 1,NN) 0198 

CALL FAPSUMI NN-l,DATA»SUMCK ) 0199 

IF ( SUMCK-DATA( NN) ) 160,180,160 0200 

160 CONTINUE 0201 

WRITE OUTPUT TAPE N,170,IFILE 0202 

PRINT 170,IFILE 0203 

170 FORMAT ( 21H BAD SUMCHECK ON FILE, 16) 0204 

180 IFILE S IF1LE+1 0205 

CALL FSKIP( ITAPE,+i) 0206 

GO TO 15 0207 
C THIS IS AN INTERNAL SUBROUTINE TO CHECK IF A DATA WORD HAS ILLEGAL 0208 

C CHARACTERS FOR ALPHANUMERIC PRINTING. 0209 

5000 DO 1 1*1,6 0210 

CALL SHFTR2( 18-1*6, TES, i,T£Z, IANS) 0211 

B T£Z=TEZ*000077000000 0212 

K=XSAMEF(TEZ)+1 0213 
GO T0Cl,l,Ul,Ul»l,l,l,L,2,l,2,2,2,2,l,l,l,l,l,l,Ui»liU»2,m,2, 0214 

1 2, 2, 1,1, 1,1, 1,1, 1,1, 1,1, 2, 2, I, 2, 2, 2, I, 1,1, 1,1, 1,1, 1,1 ,1 ,2, 0215 

2 1,1, 2, 2, 2), K 0216 

1 CONTINUE 0217 
GO TO (200,310,360), Ji 0218 

2 GO TO (215, 320, 370), Jl 0219 
END 0220 



•*»**»«*••••«»**»»»*•»«* 
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«***•»•»«*»*•••»«»*««•** 
* LOC * 
•***»♦**•*•• •»•**•** 



* LOC (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0053 

* FAP 0001 
•LOC 0002 

COUNT 30 0003 

LBL LOC 0004 

ENTRY LOC (VAR, I ADD ) 0005 

* 0006 

» —--ABSTRACT 0007 

» 0008 

» TITLE - LOC 0009 

* CORE LOCATION WITH INDEXABLE ARGUMENT 0010 

* 0011 

* LOC GIVES THE CORE ADDRESS OF A VARIABLE. THE VARIABLE 0012 

* MAY BE SUBSCRIPTED. 0013 
» 0014 
« LANGUAGE - FAP « SUBROUTINE (FORTRAN II COMPATIBLE) 0015 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0016 

* STORAGE - 4 REGISTERS 0017 
» SPEED - ABOUT 12 MACHINE CYCLES 0018 

* AUTHOR - R.A. WIGGINS, MAY, 1962 0019 

* 0020 

* —USAGE 0021 

* 0022 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0023 

* AND FORTRAN SYSTEM ROUTINES - NONE 0024 
» 0025 

* FORTRAN USAGE 0026 
« CALL LOC ( V AR , I ADD ) 0027 

* 0028 

* INPUTS 0029 

* 0030 

* VAR IS VARIABLE NAME (NEED NOT BE FLOATING POINT NAME ) ♦ 0031 

* 0032 
» OUTPUTS 0033 

* 0034 

* I ADD IS THE CORE ADDRESS FOR THE VARIABLE NAME. 0035 

* IS FORTRAN II INTEGER 0036 
» 0037 

* EXAMPLES 0038 
» 0039 

* 1. INPUTS - SUPPOSE VARU...5) IS STORED BEGINNING AT 77461 OCTAL 0040 
» USAGE - CALL LOC ( VAR, IADD) 0041 
» OUTPUTS - IADD = 32561 (=OCTAL 77461) 0042 

* 0043 

* 2. INPUTS - SAME AS EXAMPLE 1. 0044 

* USAGE - 1=3 0045 
» CALL LOC (VAR(I),IADD) 0046 

* OUTPUTS - IADD = 32559 (*OCTAL 77457) 0047 

* 0048 
LOC CAL 1,4 0049 

ALS 18 0050 

STD* 2,4 0051 

TRA 3,4 0052 

END 0053 
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« TITLE - LOCATE 



DEDICATED TO JACKIE 



( SUBRU 1 , SUBRU2 , . . . , SUBRUN ) 
( SUBRU 1 1 ANS , LOC • NARGS ) 

( SUBRU , I ANS 9 SPACER , ARG1 , ARG2 , . . . , ARGN ) 
(SUBRUV, I ANS) 

( SUBRU « SUBRUV , ARG1 , ARG2 , . . . , ARGN ) 
( LOC ALL, NARGS, XR1, XR2) 
(L0CALL,XR1,XR2) 

( LOC ALL » NUM ARG ) (FUNCTION) 
(LOCALLt NUHARG* IXVECT) C FUNCTION ) 

(LOCALLt NUMARGt IXVECT ) C FUNCTION) 

C ARGU , LOC AL L , NUMARG , I XVECT ) 
(LOCALL) (FUNCTION) 
( HNAME 1 , HNAME 2 ) ( FUNCT I ON ) 

ABSTRACT 

WITH SECONDARY ENTRIES WHERE, CALL, CALL2, SETSBV, SETUP, 
RETURN, X INDEX ( FUNCTION ) , 
ARG! FUNCTION), XARG (FUNCTION), 
STORE , XNARGS ( FUNCT I ON ) , 
AND XNAME (FUNCT ION). 

LOCATE AND OPERATE SUBROUTINES BY PROXY CALL STATEMENTS 

LOCATE AND ITS ASSOCIATED ENTRIES ENABLE A FORTRAN II 
PROGRAM (AT LEVEL 1) TO INDUCE A SUBROUTINE (AT LEVEL 2) 
TO OPERATE, VIA PROXY CALL STATEMENTS (ENTRIES CALL AND 
CALL2), ONE OR MORE STILL LOWER LEVEL SUBROUTINES, 
WHERE THE SUBROUTINE AT LEVEL 2 NEED NOT KNOW IN 
ADVANCE ANYTHING ABOUT THE LOWER LEVEL SUBROUTINES 
(I.E., HOW MANY SUBROUTINES THERE ARE, WHAT THEIR 
NAMES ARE, WHAT THEIR FUNCTIONS ARE, OR WHAT THE 
NUMBER OF ARGUMENTS ASSOCIATED WITH EACH IS). 

THE MOST SIGNIFICANT APPLICATION OF SUCH A FEATURE IS IN 
THE CONSTRUCTION OF A CONTROL SUBROUTINE WHOSE FUNCTION 
IS TO OPERATE, WITHIN THE FORMAL FRAMEWORK OF SOME GOAL, 
A REPERTOIRE OF LOWER LEVEL SUBROUTINES WHICH IS VARIABLE 
IN NUMBER AND NAMES AND PERHAPS EVOLVING WITH TIME. THE 
CONTROL SUBROUTINE CAN BE ISOLATED FROM SUCH CHANGES AND 
REMAIN WITHIN THE FORTRAN- I I SYSTEM, AND THE MACHINE 
MEMORY REQUIREMENTS DURING ANY ONE EXECUTION ARE CONFINED 
TO THOSE OF THE SPECIFIC SUBSET OF SUBROUTINES DESIRED 
DURING THAT EXECUTION. 

CHAINS OF SUCCESSIVE PROXY CALL STATEMENTS WILL WORK 
PROPERLY, AND ONE OF THE ENTRIES (CALL) PERMITS PROXY 
CALL STATEMENTS OF UNORTHODOX SUBROUTINES (SUCH AS DISPLA 
AND GENHOL OR LOCATE ITSELF) WHICH UTILIZE INFORMATION 
FROM THE STATEMENT (S) IMMEDIATELY FOLLOWING THEIR CALL 
STATEMENT. 

AS BY-PRODUCTS OF THE ABOVE FUNCTIONS, THE LOCATE GROUP 
ALSO ENABLES 

1. FORTRAN PROGRAMS TO FIND, AT EXECUTION TIME, THE 
ABSOLUTE MACHINE LOCATIONS OF THE ENTRY POINTS OF 
ANY SUBROUTINES WHOSE NAMES ARE KNOWN IN ADVANCE 
(ENTRIES LOCATE AND WHERE). 

2. THE OPERATION OF A SUBROUTINE UNDER ONE OR MORE 
PSEUDONYMS, AND THE OPERATION OF DIFFERENT 
SUBROUTINES UNDER THE SAME NAME (ENTRY LOCATE). 

3. FORTRAN SUBROUTINES TO BE WRITTEN WITH VARIABLE- 
LENGTH CALLING SEQUENCES (ENTRIES SETUP AND RETURN). 

4. SUCH A VARIABLE-LENGTH-CALLING-SEQUENCE PROGRAM TO 
OBTAIN EASILY ANY OF ITS ARGUMENTS, EVEN IF ITS 
SUBROUTINE CARD LISTS NO ARGUMENTS AT ALL (ENTRIES 
XINDEX, ARG, AND XARG (ALL FORTRAN FUNCTIONS)). 

5. THE OPERATION OF A SUBROUTINE WHOSE ARGUMENT COUNT 



2007 
0001 
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0057 
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0064 
0065 
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0070 
0071 
0072 
0073 
0074 
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* IS LIMITED ONLY BY THE MEMORY SIZE ( ENTRY CALL2). 0075 

* 6. THE TRANSMISSION THRU SUBROUTINE LAYERS OF 0076 
» ARBITRARILY COMPLEX CALLING SEQUENCES VIA SINGLE 0077 
» NUMBERS (ENTRIES SETUPt XINDEX, ARG AND XARG, 0078 
« XNARGS AND STORE )• 0079 

* 7, DIRECT RETURN LINKAGES FROM LOW LEVEL SUBROUTINES 0080 

* TO HIGH LEVEL ROUTINES WHICH BYPASS INTERMEDIATE 0081 

* LEVELS AND STILL ALLOW RETURN MESSAGES C ENTRIES 0082 

* RETURN AND STORE). 0083 

* 8. SUBROUTINE TRANSFER PATHS WHICH ARE CIRCULAR, E.G., 0084 

* A SUBROUTINE CALLING ITSELF, OR CALLING A SUBROUTINE 0085 

* WHICH CALLS IT BACK (ENTRIES SETUP AND RETURN). 0086 

* 0087 

* THE LOCATE GROUP IS DEPENDENT ON THE SUBROUTINE LINKAGE 0088 
« CONCEPT I TRANSFER VECTOR AND ARGUMENT VECTOR (TSX ARG, 0) ) 0089 

* OF THE FORTRAN SYSTEM AND MONITOR SYSTEM. IT WILL NOT 0090 

* WORK ON SYSTEMS WITH DIFFERENT LINKAGE PATTERNS. WITHIN 0091 

* THE FORTRAN II SYSTEM, HOWEVER, THESE PROGRAMS WORK 0092 

* INDEPENDENTLY OF THE INCLUSION OR EXCLUSION OF THE 0093 

* STANDARO ERROR PROCEDURE WHICH IS AN OPTIONAL FUNCTION 0094 
« AFFECTING LINKAGE FORMAT. 0095 

* 0096 
« LANGUAGE - FAP SUBROUTINES (COMPATIBLE WITH FORTRAN-I I AS 0097 

* SUBROUTINES OR FUNCTIONS DEPENDING 0098 

* ON THE ENTRY) 0099 
« EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0100 

* STORAGE - 512 REGISTERS 0101 

* LOCATE IS A MINIMUM STORAGE PROGRAM 0102 

* 0103 
« SPEED - VARIABLE DEPENDING ON ENTRY. SINCE THE SYSTEM IS 0104 

* DESIGNED FOR PRACTICAL APPLICATIONS INVOLVING NON-TRIVIAL 0105 

* SUBROUTINES THE EXTRA TIME TAKEN BY THE LOCATE ROUTINES 0106 

* TO ESTABLISH LINKAGE SHOULO NOT BE SIGNIFICANT. 0107 

* APPROXIMATE TIMES (IN MACHINE CYCLES) ARE 0108 
« LOCATE - 160 (MINIMUM) 0109 

* WHERE - 400 (MINIMUM) 0110 
» CALL - 570 ( MINI MUM 0111 
« CALL2 - 610 (MINIMUM) 0112 

* SETSBV - 330 (MINIMUM) 0113 

* SETUP - 430 (MINIMUM) 0114 
» RETURN - 250 0115 
« XINDEX - 44 0116 

* ARG (OR XARG) - 41 0117 
« STORE - 157 0118 
« XNARGS - 82 (MINIMUM) 0119 
« XNAME - 58 (MINIMUM) 0120 
» 0121 
» AUTHOR - S.M.SIMPSON, MARCH 1963 0122 

* 0123 

* 0124 

* USAGE 0125 

* 0126 
« TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0127 
« AND FORTRAN SYSTEM ROUTINES - (NONE) 0128 

* 0129 

* PRELIMINARY NOTES - 0130 

* 0131 

* 1. ILLEGAL ARGUMENT COUNTS 0132 

* IF ANY OF THE 8 SUBROUTINE ENTRIES IN THE LOCATE GROUP 0133 
« ARE CALLED WITH AN INCORRECT ARGUMENT COUNT EXECUTION 0134 

* STOPS ON AN HPR 77777(0CTAL) INSTRUCTION, WITH 0135 

* AC = 6H( NAME OF ENTRY CALLED ILLEGALLY) 0136 

* MQ * NO. OF ARGUMENTS (IN ADDRESS OF MQ) 0137 
« INDEX REGISTER 4 = ADDRESS OF ILLEGAL CALL STATEMENT 0138 
« (NOT TWO»S COMPLEMENT OF ADDRESS) 0139 
« IF COMPUTER IS RESTARTED CONTROL RETURNS IMMEDIATELY TO 0140 

* THE STATEMENT FOLLOWING THE ILLEGAL CALL STATEMENT. 0141 

* 0142 
« FOR THE VARIABLE-LENGTH-CALLING-SEQUENCE ENTRIES THE 0143 

* ILLEGAL ARGUMENT COUNTS ARE 0144 
« LOCATE - ZERO 0145 

* CALL - LESS THAN THREE 0146 

* SETSBV - LESS THAN TWO 0147 

* 0148 
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* NO ARGUMENT COUNf CHECK IS MAOE FOR THE FUNCTION ENTRIES. 0149 

* 0150 
« 2. RESTORATION OF INDEX REGISTERS I PRIMARILY OF CONCERN 0151 

* TO USERS MIXING FAP AND FORTRAN PROGRAMS) 0152 
« ALL ENTRIES OF LOCATE RESTORE INDEX REGISTERS 1 AND 2 0153 
« WITH PROVISOS IN THE CASES OF CALL, CALL2 , AND RETURN. 0154 

* INDEX REGISTER 4, USED FOR LINKAGE, IS SOMETIMES NOT 0155 
« RESTORED. CALL AND CALL2 DEFEND ON THE SUBROUTINE BEING 0156 

* OPERATED TO RESTORE INDEX REGISTERS 1 AND 2 (THE CORRECT 0157 

* VALUES ARE SET UP FOR THE SUBROUTINE BEFORE IT IS 0158 

* ENTERED). THE RESTORATION OF XR1 AND XR2 BY RETURN 0159 
« DEPENDS ON THE EXISTENCE OF CONTIGUOUS SXD INSTRUCTIONS 0160 
» AS THE VERY FIRST INSTRUCTIONS IN THE SUBROUTINE FROM 0161 

* WHICH THE RETURN COR THE APPARENT RETURN IN THE CASE OF 0162 
» SKIP RETURNS) IS DESIRED. FAP PROGRAMS USING ENTRY 0163 
« RETURN SHOULD CONFORM TO THIS CONVENTION. 0164 

* 0165 

* 0166 
« XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY LOCATE 0167 

* 0168 
« FORTRAN USAGE OF LOCATE 0169 
» 0170 
« SUBROUTINE LOCATE ESTABLISHES AN EQUIVALENCE BETWEEN 0171 

* NAMES AND ABSOLUTE MACHINE LOCATIONS OF SUBROUTINES, 0172 

* WHICH EQUIVALENCE IS UTILIZED IN SUBSEQUENT PROXY CALL 0173 

* STATEMENTS. AN APPROPRIATE CALL LOCATE STATEMENT MUST BE 0174 

* EXECUTED PRIOR TO THE USE OF THE ENTRIES WHERE, CALL, 0175 
« OR CALL2. HOWEVER A CALL LOCATE STATEMENT NEED NOT BE 0176 
« PRESENT IN A ROUTINE WHICH MAKES PROXY CALL STATEMENTS, 0177 

* PROVIDED SOME OTHER ROUTINE HAS CALLED LOCATE PREVIOUSLY. 0178 

* LOCATE IS CALLED WITH AN ARBITRARY NUMBER OF ARGUMENTS, 0179 
» N, AS FOLLOWS. 0180 
» 0181 

* CALL L0CATE(SUBRUl,SUBRU2,...,SU8RUN) 0182 
« WHICH MUST BE FOLLOWED IMMEDIATELY BY N CALL STATEMENTS AS FOLLOWS 0183 
« CALL SUBR1 (ARG11,ARG12,...,ARG1M1) 0184 
» CALL SUBR2 ( ARG21, ARG22 , ... , ARG2M2 ) 0185 
» . 0186 
« . 0187 

* . 0188 
« CALL SUBRN (ARGN1, ARGN2, . .. ,ARGNMN) 0189 
» 0190 
» THE N CALL STATEMENTS FOLLOWING THE CALL LOCATE STATEMENT 0191 

* ARE NOT EXECUTED. LOCATE RETURNS CONTROL TO THE 0192 

* STATEMENT FOLLOWING CALL SUBRN. (IT DOESNT MATTER IF THE 0193 
» (N + DTH STATEMENT FOLLOWING CALL LOCATE IS ALSO A CALL 0194 

* STATEMENT.) IN THE ABOVE ILLUSTRATION THE CALL SUBR 0195 

* STATEMENTS ARE WRITTEN WITH INDIVIDUAL ARGUMENT LISTS. 0196 
« THE OPERATION OF LOCATE, CALL AND CALL2 IS UNAFFECTED BY 0197 
» THE LENGTHS OR CONTENTS OF THESE ARGUMENT LISTS. THE 0198 
» CALL SUBR STATEMENTS CAN BE WRITTEN EQUALLY AS WELL WITH 0199 

* NO ARGUMENTS. 0200 

* 0201 
» INPUTS TO LOCATE 0202 
» 0203 
« SUBRU1 IS 6 OR LESS HOLLERITH TO BE USED IN SUBSEQUENT WHERE, 0204 

* CALL OR CALL2 STATEMENTS AS THE NAME OF THE FIRST 0205 

* SUBROUTINE IN THE LIST OF N CALL SUBR STATEMENTS WHICH 0206 
» IMMEDIATELY FOLLOW THE CALL LOCATE STATEMENT. THE NAME 0207 

* SUBRU1 DOES NOT HAVE TO BE IDENTICAL TO THE REAL 0208 
« SUBROUTINE NAME, SUBRl, AS IT APPEARS IN THE CALL SUBR1 0209 

* STATEMENT. IF IT IS DIFFERENT FROM THE REAL NAME, 0210 

* SUBRU1 DOES NOT HAVE TO CONFORM TO FORTRAN NAMING 0211 
» CONVENTIONS (E.G., IT COULD BEGIN WITH A NUMBER, 0212 
« INCLUDE SPECIAL CHARACTERS, OR EVEN BE 6 BLANKS). 0213 
» SUBRU1 MUST BE IN FORMAT ( 1 A6 ) • IF SUBRl INVOLVES LESS 0214 
» THAN 6 CHARACTERS THE POSITIONING OF THESE CHARACTERS 0215 

* IS IMMATERIAL (SINCE WHERE, CALL AND CALL2 LEFT ADJUST 0216 
« NAMES BEFORE COMPARING) BUT THE MISSING CHARACTERS MUST 0217 
« BE BLANKS (OCT 60) AND EXTERNAL TO THE NAME. IF SUBRUi 0218 

* INVOLVES A BLANK CHARACTER BETWEEN TWO NON-BLANK 0219 
« CHARACTERS THE BLANK CHARACTER IS CONSIDERED PART OF 0220 
« THE NAME. 0221 

* 0222 

* SUBRU2 IS 6 OR LESS HOLLERITH TO BE USED AS THE NAME OF THE 0223 
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* SECOND SUBROUTINE IN THE LIST OF CALL SUBR STATEMENTS 0224 

* FOLLOWING THE CALL LOCATE STATEMENT • IT HAS THE SAME 0225 
» CHARACTERISTICS AS SUBRUl. 0226 

* SUBRU2 SHOULD NOT BE IDENTICAL TO SUBRUl (I.E., IT IS 0227 

* IMPOSSIBLE IN THIS SYSTEM TO GIVE THE SAME NAME 0228 
» SIMULTANEOUSLY TO TWO DIFFERENT SUBROUTINES ALTHOUGH 0229 
« IT CAN BE DONE SEQUENTIALLY BY REPEATED CALL LOCATE 0230 

* STATEMENTS AS DESCRIBED BELOW). IF THEY ARE IDENTICAL 023L 

* THEN SUBSEQUENT REFERENCE IN PROXY CALL STATEMENTS 0232 
» TO SUBRU2 = SUBRUl WILL BE TRANSLATED AS A REFERENCE 0233 
» TO SUBR1, AND SUBR2 WILL NEVER BE OPERATED. IN GENERAL 0234 
« IF SUBRUK IS IDENTICAL TO SUBRUL (K LESS THAN L) AND 0235 

* DIFFERENT FROM SUBRUJ (FOR ALL J LESS THAN K) THEN THE 0236 

* NAME SUBRUL=SUBRUK IMPLIES THE SUBROUTINE SUBRK. 0237 

* HOWEVER THE CONVERSE WILL WORK, I.E., SUBR1 MAY BE THE 0238 

* SAME AS SUBR2, SO THAT SUBR1 CAN BE OPERATED EITHER 0239 

* UNDER THE NAME SUBRUl OR UNDER THE NAME SUBRU2. 0240 

* 0241 

* . . 0242 
» . . 0243 

* . . 0244 
« 0245 

* SUBRUN IS THE NAME TO BE USED FOR THE LAST SUBROUTINE (SUBRN) OF 0246 
» THE CALL LIST. THE NO. OF CALL STATEMENTS, NC, 0247 

* FOLLOWING THE CALL LOCATE STATEMENT SHOULD MATCH 0248 
» EXACTLY THE NO. OF ARGUMENTS, NA, IN THE CALL LOCATE 0249 
« STATEMENT. IF NC IS LESS THAN NA CONTROL WILL BE 0250 

* RETURNED TO THE STATEMENT FOLLOWING THE CALL SUBRNC 0251 
« STATEMENT AND ARGUMENT NOS. NC+l,NC+2, • • • ,NA OF CALL 0252 
« LOCATE WILL NOT BE RECOGNIZABLE IN PROXY CALL 0253 

* STATEMENTS. 0254 
« IF NC IS GREATER THAN NA, LOCATE RETURNS CONTROL TO THE 0255 

* STATEMENT FOLLOWING CALL SUBRNA, AND THE CALL 0256 
« SUBR(NAU) STATEMENT WILL BE EXECUTED. 0257 

* 0258 
« AS PRESENTLY WRITTEN LOCATE KEEPS RECORDS ONLY OF THE 0259 
» LAST 14 CALL STATEMENTS MADE (AS EXECUTED FROM DIFFERENT 0260 

* POSITIONS IN THE MEMORY, I.E., REPEATED EXECUTION OF THE 0261 
» SAME CALL LOCATE STATEMENT, SAY IN A LOOP, COUNTS ONLY 0262 

* ONCE). LOCATE KEEPS ITS TABLES IN A REVOLVING FASHION 0263 

* (CALL NO. 15 REPLACES CALL NO. 1) SO THAT ALL CALL LOCATE 0264 

* STATEMENTS CAN BE ASSIGNED TABLE INDICES FROM 1 TO 14 0265 

* (WHICH ARE NOT NECESSARILY IN THE SAME RELATIVE ORDER AS 0266 
« THEIR TIME-OF-EXECUTION INDICES). IF TWO DIFFERENT CALL 0267 

* LOCATE STATEMENTS WITHIN THE LAST 14 EXECUTED ATTEMPT TO 0268 
» DEFINE THE SAME PROXY NAME THEN THE DEFINITION ASSOCIATED 0269 

* WITH THE LOWEST TABLE INDEX IS USED. 0270 

* 0271 

* (THE LIMIT OF 14 ON L0CATE»S MEMORY CAN BE MOVED UP OR 0272 
« DOWN BY MAKING THE FOLLOWING CHANGES TO THE PROGRAM (SEE 0273 

* LISTING NEAR END) 0274 
» 1. CHANGE THE CONSTANT KTABLE FROM 14 TO THE NEW VALUE 0275 
« DESIRED 0276 
« 2. CHANGE THE BSS 12 INSTRUCTION (FIRST INSTRUCTION IN 0277 
« LIST OF VARIABLES) TO BSS (NEW VALUE - 2). ) 0278 

* 0279 
» A SCHEME SUCH AS THE FOLLOWING WILL ENABLE ONE TO 0280 

* OPERATE A SINGLE SUBROUTINE UNDER DIFFERENT NAMES. 0281 

* 0282 

* ITIME=0 0283 

* SUBRUl -5HSUBRU 0284 

* SUBRU2*5HDUMMY 0285 
» GO TO 50 0286 

* 1 (OPERATE SUBR1 UNDER THE NAME SUBRU) 0287 
» . 0288 
» . 0289 

* . 0290 
« SUBRU1=5HDUMMY 0291 
» SUBRU2=5HSUBRU 0292 

* GO TO 50 0293 
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« 2 (OPERATE SUBR2 UNDER THE NAME SUBRU) 0294 

* -. 0295 

* . 0296 

* . 0297 

* . 0298 

* . 0299 

* 50 CALL LOCATE ( SU8RU1 t SUBRU2 ) 0300 

* CALL SUBR1 0301 

* CALL SUBR2 0302 
» ITIME*ITIME*1 0303 

* GO TO (l,2),ITIME 0304 

* 0305 
« XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY WHERE 0306 
» 0307 

* FORTRAN USAGE OF WHERE 0308 
» 0309 

* CALL WHERE! SUBRU, IANS, LOC, NARGS) 0310 
» 0311 

* INPUTS TO WHERE 0312 

* 0313 

* SUBRU IS THE PROXY NAME, IN FORMAT! 1A6) , OF THE SUBROUTINE 0314 

* TO BE FOUND ACCORDING TO THE DATA STORED BY LOCATE. 0315 

* SUBRU SHOULD APPEAR AS ONE OF THE ARGUMENTS OF SOME 0316 

* PRIOR CALL LOCATE STATEMENT. 0317 

* 0318 

* OUTPUTS FROM WHERE 0319 
« 0320 

* IANS » 0 MEANS SUBROUTINE WAS LOCATED. 0321 

* * -1 MEANS NOT LOCATED, BUT THE TABLES ARE IN ORDER. 0322 

* * -2 MEANS NOT LOCATED. SUBRU WAS FOUND AS ONE OF THE 0323 
» ARGUMENTS OF A CALL LOCATE STATEMENT, BUT THE 0324 

* ASSOCIATED LIST OF CALL STATEMENTS WAS TOO SHORT 0325 

* TO EQUATE SUBRU WITH A REAL SUBROUTINE. 0326 

* = -3 MEANS NOT LOCATED. NO CALL LOCATE STATEMENTS HAVE 0327 
» BEEN MADE YET. 0328 

* = -4 MEANS NOT LOCATED. THE MEMORY CAPACITY (20) OF 0329 
» LOCATE HAS BEEN EXCEEDED AND THIS NAME MAY HAVE 0330 

* BEEN ASSOCIATED WITH A CALL LOCATE STATEMENT NOW 0331 
« FORGOTTEN. 0332 
» 0333 
» LOC IS UNDISTURBED UNLESS IANS=0. IF IANS=0 THEN LOC GIVES 0334 

* THE ABSOLUTE MACHINE ADDRESS OF THE ENTRY POINT OF THE 0335 
» SUBROUTINE WHOSE PROXY NAME IS SUBRU (REAL NAME » SUBR) 0336 
« 0337 
» NARGS IS UNDISTURBED UNLESS IANS=0. IF IANS=0 THEN NARGS IS 0338 

* THE NO. OF ARGUMENTS OF SUBROUTINE SUBR AS WRITTEN DOWN 0339 

* IN THE CALL SUBR STATEMENT IN THE LIST FOLLOWING THE 0340 
» CALL LOCATE STATEMENT WHICH DEFINED SUBRU. (THE PROXY 0341 

* CALL STATEMENTS USE WHERE TO FIND SUBROUTINES BUT DO 0342 

* NOT UTILIZE THE OUTPUT NARGS.) 0343 

* 0344 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY CALL 0345 

* 0346 

* FORTRAN USAGE OF CALL 0347 

* 0348 

* THE PROXY STATEMENT 0349 
» 0350 

* CALL CALL(SUBRU,IANS,SPACER,ARGl,ARG2,...,ARGN) 0351 

* 0352 

* IS FUNCTIONALLY EQUIVALENT TO THE STATEMENT 0353 
» 0354 
« CALL SUBR( ARG1, ARG2, . . • ,ARGN) 0355 

* 0356 
« PROVIOED 0357 
» 1. THE NAME SUBRU HAS BEEN EQUATED TO SUBR BY A PRIOR 0358 
« CALL LOCATE STATEMENT 0359 

* 2. SUBR IS A SUBROUTINE WHICH ONLY USES INFORMATION 0360 

* A) FROM ITS ARGUMENTS ARG1...ARGN 0361 

* AND POSSIBLY 0362 
« B) FROM THE STATEMENTS FOLLOWING THE CALL CALL 0363 
« STATEMENT 0364 
« SUBROUTINES WHICH UTILIZE INFORMATION PRIOR TO THEIR CALL 0365 

* STATEMENTS MAY OR MAY NOT BE SUCCESSFULLY PROXIED (THE 0366 

* SUBROUTINE SETUP DESCRIBED BELOW IS ONE WHICH CAN BE). 0367 
« THE QUESTION MUST BE RESOLVED IN EACH CASE REFERENCING 0368 
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* THE LOGIC DETAILS OF SUBROUTINE CALL. 0369 
« 0370 

* INPUTS TO CALL 0371 

* 0372 
» SUBRU IS 6 HOLLERITH FOR THE PROXY NAME, IN F0RMATUA6) 0373 
« 0374 

* SPACER IS ANY DUMMY VARIABLE (ITS VALUE IS NEITHER USED NOR 0375 
» CHANGED) 0376 

* 0377 

* AR61. • « ARGN ARE THE SUBROUTINE ARGUMENTS, N IN NUMBER WHERE N MAY 0378 
« BE ZERO. 0379 

* 0380 

* OUTPUTS FROM CALL 0381 

* 0382 

* IANS * 0 INDICATES NO TROUBLE, IN WHICH CASE THE IMPORTANT 0383 
» OUTPUTS ARE THOSE (IF ANY) OF SUBROUTINE SUBR 0384 

* * -1 THRU -4 HAS SAME SIGNIFICANCE AS FOR SUBROUTINE 0385 

* WHERE, AND THE SUBROUTINE WAS NOT OPERATED. 0386 

* 0387 
« THE SUBROUTINE CALL ITSELF MAY BE PROXIED. 0388 
» CALL CALL(4HCALL, IANS1, SPACER, SU8RU,IANS2, SPACER, 0389 

* 1 ARG1 , ARG2 , . . •, ARGN) 0390 
» IS EQUIVALENT TO THE ABOVE WHERE IANSl NOW REFERS TO 0391 

* WHETHER OR NOT CALL HAS APPEARED IN A CALL LOCATE 0392 

* STATEMENT, AND IANS2 REFERS TO SUBRU. 0393 

* 0394 

* 0395 

* FAP DESCRIPTION OF THE FUNCTIONING OF CALL (BASIC OUTLINE) 0396 

* 0397 

* THE STATEMENT CALL CALL( SUBRU, IANS, SPACER, ARG1,ARG2, ... ) 0398 
« COMPILES TO 0399 
» 0400 
« LOCALL TSX $CALL,4 0401 

* +1 TSX A(SUBRU),4 A(C) STANDS FOR ADDRESS OF C 0402 
« +2 TSX AC IANS), 0 0403 
« +3 TSX A(SPACER),0 0404 

* +4 TSX A(ARGI),0 0405 
« +5 TSX A(ARG2),0 0406 

* . 0407 
« . 0408 

* CALL FINOS FROM WHERE THE ENTRY (LOC) OF THE DESIRED 0409 
» SUBROUTINE, THEN CONVERTS LOCALL+3 TO READ TSX LOC, 4 , 0410 
« AND FINALLY TRANSFERS CONTROL TO LOCALL+3. 0411 
» 0412 

* 0413 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY CALL2 0414 
« 0415 

* FORTRAN USAGE OF CALL2 0416 

* 0417 

* CALL2 DIFFERS FROM CALL PRINCIPALLY IN THAT ALL THE 0418 

* INFORMATION ABOUT THE SUBROUTINE BEING PROXIED IS PACKED 0419 
« UP IN A SINGLE VECTOR, AND THAT THE CLASS OF PROXYABLE 0420 
« SUBROUTINES IS SLIGHTLY SMALLER. 0421 

* 0422 

* THE STATEMENT 0423 
» CALL CALL2(SUBRUV,IANS) 0424 
» IS FUNCTIONALLY EQUIVALENT TO THE STATEMENT 0425 
« CALL SUBR ( ARG1, ARG2, . • . , ARGN) 0426 

* PROVIDED 0427 
« 1. THE SUBROUTINE VECTOR SUBRUV( 1 . . .N+4 ) IS SET UP IN 0428 

* ADVANCE AS DEFINED BELOW 0429 

* 2. SUBR IS A SUBROUTINE WHICH UTILIZES INFORMATION ONLY 0430 

* FROM ITS ARGUMENTS. 0431 
« 0432 
« INPUTS TO CALL 2 0433 

* 0434 
« SUBRUV(I) 1=1,2, ...,N+4 DEFINES THE SUBROUTINE DESIRED AND ITS 0435 
» ARGUMENTS AS FOLLOWS 0436 

* SUBRUV(l) » SUBRU » PROXY NAME OF SUBROUTINE, IN 0437 

* F0RMATUA6) 0438 

* |2) = N-NARGS = NO. OF ARGUMENTS OF THE 0439 

* SUBROUTINE (FIXED POINT) 0440 

* (3) = FENCE ■ OCTAL 777777777777 (MUST BE PRESENT 0441 
» EVEN IF N=0) 0442 
» C4) = IXARG1 MUST 0443 
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* (5) » IXARG2 BE 0444 

* . 0445 
» • FIXED 0446 

* . 0447 
« (N+3) « IXARGN POINT 0448 

* (N+4) = FENCE * OCTAL 777777777777 < MUST BE PRESENT 0449 
« EVEN IF N=0) 0450 
« WHERE IXARG IS THE INDEX OF ARG WITH RESPECT TO THE 0451 

* FORTRAN COMMON BLOCK, OBTAINABLE FOR EXAMPLE BY THE 0452 
» STATEMENTS 0453 

* COMMON COM 0454 
» IXARG * XLOCF(COM) - XLOCF ( ARG) ♦ 1 0455 

* 0456 
» THE SUBROUTINE VECTOR, SUBRUVU), IS A MIXEO VECTOR WITH 0457 

* A NAMING PROBLEM. IT CAN BE CONSTRUCTED BY FORTRAN 0458 
« STATEMENTS FOLLOWING AN EQUIVALENCE STATEMENT TO GIVE 0459 

* SUBRUVU) A FIXED POINT ALIAS, SAY ISUBRV(I), BUT THIS 0460 
« PROCEDURE IS CUMBERSOME. IT IS EASIER TO USE THE NEXT 0461 

* ENTRY SETSBV TO CONSTRUCT SUBRUVU) WITH A SINGLE CALL 0462 
« STATEMENT. 0463 
« 0464 
» OUTPUTS THE PRINCIPAL OUTPUTS ARE FROM THE SUBROUTINE OPERATED 0465 

* (IF IT HAS OUTPUTS), BUT THE SUBROUTINE WILL BE OPERATED 0466 
« ONLY IF THE IANS OUTPUT BELOW IS ZERO. 0467 

* 0468 

* SUBRUVU) CALL2 LEAVES SUBRUVI 3, 4, . . . ,NARGS+4 ) MODIFIED, AND SOME 0469 

* CAUTION MUST BE TAKEN IN REPEATED USE OF THE SAME CALL 0470 

* CALL2 STATEMENT OR OF A SUBSEQUENT CALL CALL 2 STATEMENT 0471 

* INVOLVING THE SAME SUBROUTINE VECTOR SUBRUVU). THE 0472 

* BASIC RULES ARE 0473 

* 1. REPEATED OR SUBSEQUENT USE WORKS PROPERLY IF 0474 

* A) SUBRUVU. ..N+4) IS NOT DISTURBED BY THE CALLING 0475 
» PROGRAM FOLLOWING THE FIRST USE U.E., LEFT THE 0476 
» WAY CALL2 MODIFIED IT). 0477 

* (NOTE THAT THIS ALLOWS ONE TO CHANGE ANY OR ALL 0478 
« OF THE VALUES OF THE ARGUMENTS ARG1 , . . . , ARGN 0479 

* PROVIDED ONLY THAT THEIR LOCATIONS WITH RESPECT 0480 
« TO COMMON DONT CHANGE.) 0481 

* OR B) SUBRUVU. ..N+4) IS COMPLETELY RECONSTRUCTED 0482 

* BEFORE SUBSEQUENT USE 0483 

* OR C) ONLY THE NAME OF THE SUBROUTINE IS CHANGED. 0484 
« 2. REPEATED USE WILL NOT WORK PROPERLY IF 0485 
» A) NARGS IS CHANGED IN SUBRUVI 2 ) , EVEN IF THE 0486 

* SUBROUTINE REQUESTED HAS A VARIABLE LENGTH 0487 

* CALLING SEQUENCE 0488 

* OR B) SUBRUV(3...N+4) IS MODIFIED OR ONLY PARTIALLY 0489 
» RECONSTRUCTED. 0490 

* REPEATED USE OF THE SAME SUBRUV VECTOR IN DIFFERENT 0491 

* CALL STATEMENTS IS PERMITTED 0492 

* 0493 
» IANS * 0 INDICATES NO TROUBLE 0494 

* = -1...-4 HAS SAME SIGNIFICANCE AS FOR SUBROUTINE WHERE 0495 
« AND THE SUBROUTINE WAS NOT OPERATED. 0496 

* = -5 IF THIS IS THE FIRST CALL2 WITH THIS SUBRUV VECTOR 0497 

* (CALLED FIRST IF SUBRUVI3) = FENCE), BUT SOMETHING 0498 

* IS ILLEGAL ABOUT SUBRUVU). 0499 

* * -6 IF THIS IS A SECONDARY CALL2 WITH THIS SUBRUV 0500 

* VECTOR BUT THE VECTOR HAS BEEN ILLEGALLY CHANGED. 0501 
» 0502 

* CALL2, LIKE CALL, IS ALSO PROXYABLE. EITHER CALL OR 0503 

* CALL2 CAN BE USED TO PROXY BOTH CALL AND CALL2. 0504 

* 0505 
« 0506 

* FAP DESCRIPTION OF THE FUNCTIONING OF CALL2 (BASIC OUTLINE) 0507 
« 0508 

* THE STATEMENT CALL CALL2 ( SUBRUV, I ANS) COMPILES TO 0509 
» 0510 

* LOCALL TSX $CALL2,4 WITH SUBRUV( N+4 ) =OCT 777777777777 0511 

* +1 TSX A(SUBRUV,0 SUBRUVI N+3 ) =PZE 0,0, IXARG 0512 
» +2 TSX A(IANS),0 0513 
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• 


♦3 


• 






0514 


• 










0515 


• 




SUBRUV(5) 


PZE 


0,0, IXARG2 


0516 


• 




SUBRUV(4) 


PZE 


0,0, IXARG1 


0517 


* 




SU8RUV( 3) 


OCT 


777777777777 


0518 


• 




SU8RUV(2) 


PZE 


0,0,NARGS 


0519 


• 




SUBRUV(l) 


8CI 


1,SUBR0U 


0520 



* CALL2 FINDS FROM WHERE THE ENTRY (LOO OF THE DESIRED 

* SUBROUTINE AND SETS SUBRUVCN+4) TO READ TSX L0C,4 . 

* SUBRUV(4...N+3) IS REVERSED AND CONVERTED TO READ 

* TSX A( ARGN) ,0 ... TSX A(ARG1),0 RESPECTIVELY. SUBRUV(3) 
» IS REPLACED BY TRA L0CALL+3, AND FINALLY CONTROL IS 

« TRANSFERRED TO SUBRUV(N*4). 

« ON A REPEAT USE OF THE SAME SUBRUV (DETECTED BY 

* SUBRUV(3) NOT = FENCE) SUBRUV (N+4) AND SUBRUV (3) ARE 

* RESET TO (POSSIBLY) NEW VALUES, BUT SUBRUV(4. . .N+3) 

* IS LEFT ALONE. 
• 

« XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY SETSBV 

« FORTRAN USAGE OF SETSBV 
• 

* SETSBV WILL CONSTRUCT A SUBROUTINE VECTOR SUBRUV( I ) IN 

* THE FORMAT REQUIRED BY SUBROUTINE CALL2, BY THE SINGLE 
» STATEMENT 

• 

* CALL SETSBV (SUBRU, SUBRUV, ARG1 ,ARG2 , .. . , ARGN) 
», 

* INPUTS TO SETSBV 
• 

» SUBRU IS 6 HOLLERITH FOR THE SUBROUTINE NAME, IN FORMAT ( 1A6 ) 

« ARG1,...,ARGN ARE THE ARGUMENTS, IF ANY, OF THE SUBROUTINE 

* OUTPUTS FROM SETSBV 
• 

* SUBRUV(I) 1=1. ..N*4 IS THE SUBROUTINE VECTOR DESCRIBED ABOVE UNDER 

* CALL2 USAGE. (SUBRUV(I) MUST BE DIMENSIONED AT LEAST 
» OF LENGTH N+4, WHERE N=0 IF THERE ARE NO ARGUMENTS) 

• 

« XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRIES SETUP AND RETURN 

* FORTRAN USAGE OF SETUP AND RETURN 
• 

* SETUP AND RETURN INSTRUMENT LINKAGE BETWEEN THE CALLING 
» PROGRAM AND A FORTRAN-II SUBROUTINE WHICH HAS VARIABLE 

« LENGTH CALLING SEQUENCE. A CALL SETUP STATEMENT SHOULD 

* BE THE FIRST STATEMENT IN THE FORTRAN SUBROUTINE. THE 

* CALL RETURN STATEMENT SHOULD APPEAR AT LEAST ONCE 
» ANYWHERE IN THE PROGRAM, FOR EXAMPLE - 

* 

* SUBROUTINE SUBRU, B,C) 

* (DIMENSION AND EQUIVALENCE STATEMENTS, ETC., IF ANY) 

* CALL SETUP(L0CALL,NARGS,XR1,XR2) 



CALL RETURN (LOC ALL ,XR1 ,XR2) 



CALL RETURN(L0CALL,XR1,XR2) 



NOTE - 

THE SUBROUTINE CARD NEED NOT HAVE ANY ARGUMENTS LISTED 
ON IT, AND IF IT DOES THE NUMBER OF ARGUMENTS SO LISTED 
NEED NOT CORRESPOND TO THE ACTUAL NO. (NARGS) OF 
ARGUMENTS USED BY THE CALLING PROGRAM. HOWEVER, IF THE 
NUMBER OF ARGUMENTS LISTED ON THE SUBROUTINE CARD IS 
LESS THAN THAT USED BY THE CALLING PROGRAM THE 
SUBROUTINE HAS AN ACQUISITION AND/OR STORAGE PROBLEM 
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0523 
0524 
0525 
0526 
0527 
0528 
0529 
0530 
0531 
0532 
0533 
0534 
0535 
0536 
0537 
0538 
0539 
0540 
0541 
0542 
0543 
0544 
0545 
0546 
0547 
0548 
0549 
0550 
0551 
0552 
0553 
0554 
0555 
0556 
0557 
0558 
0559 
0560 
0561 
0562 
0563 
0564 
0565 
0566 
0567 
0568 
0569 
0570 
0571 
0572 
0573 
0574 
0575 
0576 
0577 
0578 
0579 
0580 
0581 
0582 
0583 
0584 
0585 
0586 
0587 
0588 
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* CONCERNING SOME OR ALL OF ITS ARGUMENTS SINCE IT HAS NO 0589 

* SPECIFIC NAMES FOR THEM. THIS PROBLEM IS SOLVED BY USE 0590 

• OF ONE OR MORE OF THE FIVE ENTRIES XINDEX, ARG, XARG, 0591 

* STORE, AND XNARGS WHICH ARE DISCUSSED BELOW* 0592 
« 0593 
« INPUTS TO SETUP 0594 

* 0595 

• SETUP HAS NO INPUT ARGUMENTS EXCEPT INDEX REGISTER 4 0596 

• WHICH WAS SET BY THE CALL SETUP STATEMENT AND DEFINES 0597 
« THE LOCATION OF THAT STATEMENT. 0598 

• ( SETUP PROCEEDS TO SCAN FROM THIS POINT BACKWARDS 0599 
» (LOWER ADDRESSES) TILL IT FINDS SXD X,Y INSTRUCTIONS 0600 

* (IN SUBROUTINE SUBR).) 0601 

* 0602 
« OUTPUTS FROM SETUP 0603 
« 0604 
« LOCALL IS THE ABSOLUTE MACHINE LOCATION OF THE CALL SUBR ( ARG 1, 0605 

* •• . , ARGN) STATEMENT IN THE CALLING PROGRAM. IN 0606 
« ORDINARY USAGE LOCALL SHOULD NOT BE CHANGED BY 0607 

* SUBROUTINE SUBR PRIOR TO THE CALL RETURN( LOCALL , 0608 

* XR1,XR2) STATEMENT. 0609 

* 0610 
» NARGS IS THE NO. OF ARGUMENTS ASSOCIATED WITH THE PRESENT CALL 0611 

* SUBR STATEMENT IN THE CALLING PROGRAM. 0612 

* (NARGS IS DETERMINED AS THE NO. OF SUCCESSIVE TSX Y,0 0613 
« INSTRUCTIONS WHICH IMMEDIATELY FOLLOW THE ADDRESS 0614 

* LOCALL). 0615 

• 0616 
» XR1 IS THE VALUE TO WHICH INDEX REGISTER 1 MUST BE RESET 0617 
« (BY RETURN) BEFORE RETURNING TO THE CALLING PROGRAM. 0618 
» 0619 

* XR2 IS THE ANALOGOUS VALUE FOR INDEX REGISTER 2. 0620 

* 0621 

♦ IN ORDINARY USAGE XR1 AND XR2 SHOULD NOT BE CHANGED BY 0622 
« SUBROUTINE SUBR PRIOR TO THE CALL RETURN( LOCALL, XR1, XR2 ) 0623 

* STATEMENT. 0624 

• 0625 

* CALL SETUP CAN NOT BE PROXIED BY A CALL2 STATEMENT. 0626 
« 0627 

♦ INPUTS TO RETURN 0628 

• 0629 
« LOCALL AS DEFINED UNDER OUTPUTS OF SETUP 0630 

♦ 0631 
« XR1 AS DEFINED UNDER OUTPUTS OF SETUP 0632 
« 0633 
« XR2 AS DEFINED UNDER OUTPUTS OF SETUP 0634 

• 0635 
» OUTPUTS FROM RETURN 0636 

* 0637 
« RETURN RETURNS CONTROL PROPERLY TO THE CALLING PROGRAM 0638 
» AND RESTORES INDEX REGISTERS FOR THE CALLING PROGRAM. 0639 

• 0640 

• BY USING RETURN IN A SLIGHTLY UNORTHODOX WAY IT IS 0641 

• POSSIBLE TO HAVE LOW LEVEL ROUTINES RETURN CONTROL 0642 

• OIRECTLY TO CALLING PROGRAMS 2 OR MORE LEVELS ABOVE THEM 0643 

* PROVIDED THE INTERMEDIATE ROUTINES PASS DOWN THE LOCALL, 0644 
« XR1, AND XR2 VALUES OF THE HIGH LEVEL ROUTINE. 0645 
« FOR EXAMPLE 0646 

* 0647 
« LEVEL 1 LEVEL 2 LEVEL 3 0648 

• 0649 
« . SUBROUTINE SUBA(...) SUBROUTINE SUBB( LOC, X,Y ) 0650 

* . CALL SETUP(LOC,N,X,Y) . 0651 
» CALL SUBA(...) . . 0652 

• . . 0653 

* . . CALL RETURN(LOC,X,Y) 0654 
» . CALL SUBBCLOC,X,Y) . 0655 

• • • • 0656 

• . . 0657 
« (IN THIS USAGE IT IS IMMATERIAL WHETHER ANY OF THE 0658 

• ROUTINES INVOLVEO HAVE A FIXED OR VARIABLE NO. OF 0659 
» ARGUMENTS.) 0660 

• 0661 

• 0662 
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* CALL RETURN CAN BE PROXIED BY CALL OR CALL2. 0663 

* 0664 

* PROGRAMS USING LINKAGE BY SETUP AND RETURN CAN BE CALLED 0665 
« BY PROXY, AND SKIP RETURNING TO PROGRAMS CALLED BY PROXY 0666 

* IS PERMITTED- 0667 
« SETUP ANO RETURN PERMIT THE USER TO PROGRAM CIRCULAR 0668 
« LOOPS BETWEEN SUBROUTINES. A PROGRAM IN SUCH A LOOP MUST 0669 
» SAVE LOCALL, XR1, XR2 IN SEPARATE LOCATIONS ACCORDING TO 0670 

* THE SUBROUTINE WHICH CALLED IT (DETERMINED, FOR EXAMPLE, 0671 

* FROM ONE OF ITS ARGUMENTS), AND THEN CALL RETURN WITH THE 0672 

* APPROPRIATE VALUES OF LOCALL, XR1, AND XR2. FOR 0673 

* ILLUSTRATION SEE COMPUTATIONAL EXAMPLE 8. 0674 

* 0675 
« 0676 

* 0677 
« XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY XINDEX 0678 
« 0679 
» 0680 
« FORTRAN USAGE OF XINDEX (FUNCTION) 0681 
» 0682 
« XINDEX FUNCTION ENABLES A VARIABLE-LENGTH-CALLING- 0683 

* SEQUENCE SUBROUTINE TO LOCATE ABSOLUTELY ANY OF ITS 0684 

* ARGUMENTS, AND REFER TO IT AS AN ORDINARY VECTOR (IN 0685 

* COMMON), REGARDLESS OF WHETHER OR NOT ITS SUBROUTINE 0686 
« CARD HAS NAMES FOR THE ARGUMENTS. THE USAGE IS - 0687 

* 0688 

* IXCOM*XINDEXF( LOCALL, NUMARG) 0689 

* 0690 

* INPUTS TO XINDEX 0691 

* 0692 
« LOCALL IS THE ABSOLUTE MACHINE ADDRESS OF THE CALLING STATEMENT 0693 

* (AS PRODUCED BY SETUP) 0694 
» 0695 
« NUMARG IS THE ARGUMENT NUMBER DESIRED 0696 

* 0697 
« OUTPUTS FROM XINDEX 0698 

* 0699 
« IXCOM IS THE INDEX WITH RESPECT TO THE COMMON BLOCK OF ARGUMENT 0700 

* NO. NUMARG. FOR EXAMPLE - 0701 

* 0702 
« CALLING PROGRAM SUBROUTINE 0703 

* 0704 

* . SUBROUTINE SUBR 0705 

* . DIMENSION C0M(2) 0706 

* . COMMON COM 0707 
» CALL SUBR(ARG1,ARG2,ARG3,...) CALL SETUP(L0C,N,X1,X2) 0708 

* (WHERE ARG3 IS SUPPOSED IX=XINDEXF ( LOC, 3 ) 0709 

* TO BE A VECTOR) A=C0M(IX+4) 0710 

* . (THEN A * ARG3(5)) 0711 

* . . 0712 

* 0713 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRIES ARG AND XARG 0714 

* 0715 

* FORTRAN USAGE OF ARG AND XARG (FUNCTIONS) 0716 

* 0717 

* ARG ANO XARG FUNCTIONS GIVE A VARIABLE-LENGTH-CALLING- 0718 
» SEQUENCE SUBROUTINE IMMEDIATE ACCESS TO ANY OF ITS 0719 
« ARGUMENTS (INCLUDING ANY ELEMENT OF ANY VECTOR ARGUMENT). 0720 
» THE FUNCTION IS SIMILAR TO THAT OF INDEX FUNCTION BUT 0721 
« MORE DIRECT. ARG AND XARG DIFFER ONLY ACCORDING TO 0722 

* WHETHER THE USER WISHES TO GIVE THE ARGUMENT A FLOATING 0723 

* OR FIXED POINT NAME RESPECTIVELY. THE USAGE IS 0724 

* 0725 

* ARGU * ARGF(LOCALL, NUMARG, IXVECT) 0726 

* OR 0727 
« I ARGU = XARGF(LOCALL, NUMARG, IXVECT) 0728 

* 0729 

* INPUTS 0730 
« 0731 
« LOCALL IS THE ABSOLUTE MACHINE ADDRESS OF THE CALLING PROGRAM. 0732 
» 0733 
« NUMARG IS THE ARGUMENT NUMBER REQUIRED. (EVERY ARGUMENT IS 0734 

* CONSIDERED BY ARGF AND XARGF TO BE A VECTOR.) 0735 

* 0736 
« IXVECT IS THE SUBSCRIPT INDEX OF THE DESIRED ELEMENT WITHIN THE 0737 
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* REQUIRED ARGUMENT VECTOR. (IF THE REQUIRED ARGUMENT 0738 

* IS CONSIDERED BY THE SUBROUTINE TO BE A SINGLE 0739 
« VARIABLE, NOT A VECTOR, THEN IXVECT SHOULD BE SET * 1) 0740 

* 0741 
« OUTPUTS 0742 

* 0743 

* ARGU 0744 

* OR 0745 

* I ARGU IS THE DESIRED ELEMENT. 0746 

* 0747 
« REFERRING TO THE EXAMPLE UNDER XINDEX, ARG3(5) COULD 0748 

* EQUALLY WELL HAVE BEEN OBTAINED BY SUBR BY THE SINGLE 0749 

* STATEMENT 0750 
« A = ARGF I LOC ALL , 3 , 5 ) 0751 

* THUS BYPASSING THE NEED FOR THE DUMMY VECTOR, COM, AND 0752 
« ITS ASSOCIATED DIMENSION AND COMMON STATEMENTS. 0753 

* 0754 

* 0755 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY STORE 0756 
« 0757 

* FORTRAN USAGE OF STORE 0758 

* 0759 
» STORE IS THE STORAGE COUNTERPART OF THE RETRIEVAL 0760 

* FUNCTIONS ARG AND IXARG. THE USAGE IS 0761 
« 0762 
« CALL STORE ( ARGU, LOCALL,NUMARG, IXVECT ) 0763 
« 0764 

* INPUTS TO STORE 0765 
« 0766 
« ARGU IS THE QUANTITY TO BE STORED. (MAY HAVE FIXED POINT NAME) 0767 

* 0768 

* LOCALL SAME AS FOR ENTRY ARG 0769 
« NUMARG DITTO 0770 

* IXVECT DITTO 0771 

* 0772 

* OUTPUTS FROM STORE 0773 

* ARGU IS STORED AS VECTOR ELEMENT NO. IXVECT, IN THE 0774 
« VECTOR ARGUMENT NO. NUMARG, RELATIVE TO CALL STATEMENT 0775 
» AT LOCALL. 0776 

* 0777 
« 0778 

* AN IMPORTANT PROPERTY OF XINDEX, ARG, XARG, AND STORE 0779 
« IS THAT THEIR PROCESSES ARE RELATIVE TO THE CONSTANT 0780 
« LOCALL WHICH IS UNDER PROGRAM CONTROL. LOCALL CAN BE 0781 

* INITIALIZED BY ONE SUBROUTINE USING SETUP AND THEN PASSED 0782 
» AS AN ARGUMENT UP OR DOWN THRU ARBITRARY SUBROUTINE 0783 
» LEVELS PERMITTING THE ARGUMENTS OF THE INITIALIZING 0784 
« SUBROUTINE TO BE TAPPED AS NEEDED BY THE OTHER ROUTINES. 0785 
» THUS, IN THE EXAMPLE OF A SKIP RETURN GIVEN ABOVE, THE 0786 

* SUBROUTINE SUBB AT LEVEL 3 COULD ACQUIRE DIRECTLY THE 0787 

* ARGUMENTS PASSED TO SUBA FROM LEVEL 1 BY USING XINDEX, 0788 
« ARG, OR XARG. IF THE INITIAL ARGUMENT STRING IS VARIABLE 0789 
» LENGTH IT MAY BE IMPORTANT THAT THE NUMBER OF ARGUMENTS 0790 

* BE ACCESSIBLE AT ALL LEVELS. THE INITIALIZING PROGRAM 0791 
« CAN PASS THIS INFORMATION ALONG WITH LOCALL, BUT THIS 0792 

* REQUIREMENT CAN BE SUPPRESSED BY REQUIRING THAT THE 0793 

* ROUTINES OBTAIN THE ARGUMENT COUNT FROM THE NEXT ENTRY 0794 
« XNARGS. 0795 
« 0796 
» 0797 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY XNARGS 0798 

* 0799 
« FORTRAN USAGE OF XNARGS (FUNCTION) 0800 

* 0801 
« NARGS=XNARGSF( LOCALL) 0802 
» 0803 

* INPUTS TO XNARGS 0804 

* 0805 

* LOCALL IS THE MACHINE ADDRESS OF ANY FORTRAN CALL STATEMENT 0806 
« (ANY TSX X,4 INSTRUCTION) 0807 

* 0808 

* OUTPUTS FROM XNARGS 0809 

* 0810 
» NARGS » NUMBER OF ARGUMENTS ASSOCIATED WITH THE CALL STATEMENT 0811 

* EXCEPT 0812 
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* -1 IF LOCALL IS NOT THE ADDRESS OF A CALL STATEMENT 



• XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXSXXXXXXXXX ENTRY XNAME 

• FORTRAN USAGE OF XNAME (FUNCTION) 
• 

» XNAME FUNCTION IS A CONVENIENCE FOR MAKING IDENTITY 

« CHECKS BETWEEN TWO HOLLERITH NAMES OF 6 CHARACTERS OR 

• LESS, WHERE THE RELATIVE LEFT OR RIGHT ADJUSTMENT (IN 
» CASE OF LESS THAN 6 CHARACTERS) OF THE NAMES IS 

• CONSIDERED IMMATERIAL. IT CAN BE USEFUL IN PROGRAM 

• SYSTEMS WHERE PROTOCOL IS BASED ON NAME EXCHANGING. THE 

• USAGE IS 
» 

• NEGDIF = XNAMEF(HNAME1 1 HNAME2 ) 
« 

« INPUTS TO XNAME 
* 

• HNAME1 IS THE FIRST OF THE TWO HOLLERITH NAMES IN FORMAT ( 1A6 ) • 
* 

» HNAME2 IS THE SECOND OF THE TWO NAMES. 

• OUTPUTS FROM XNAME 



NEGDIF (NEGATIVE IF DIFFERENT) 



♦0 IF THE NAMES MATCH 
-1 IF THE NAMES DIFFER 



* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX COMPUTATIONAL EXAMPLES 
* 

« 

« 1. EXAMPLES OF PAUSES ON ILLEGAL ARGUMENT COUNTS 
• 

* IN THE FOLLOWING PROGRAM THE COMPUTER WILL STOP AFTER EACH 

* STATEMENT ON HPR 77777. ASSUME THE OPERATOR RECORDS AC t MQ,XR4 AND 

* RESTARTS. 



• XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 

» 2. EXAMPLE INVOLVING ONLY LOCATE AND WHERE, TO SHOW THE VARIOUS 

• CONDITIONS DISTINGUISHED BY WHERE 



0813 
0814 
0815 
0816 
0817 
0818 
0819 
0820 
0821 
0822 
0823 
0824 
0825 
0826 
0827 
0828 
0829 
0830 
0831 
0832 
0833 
0834 
0835 
0836 
0837 
0838 
0839 
0840 
0841 
0842 
0843 
0844 
0845 
0846 
0847 
0848 
0849 



• 


USAGE - 1 


CALL 


LOCATE 






0850 


• 


2 


CALL 


WHERE (A,B) 






0851 


• 


3 


CALL 


WHERE (A, 8, C,D, 


E) 




0852 


• 


4 


CALL 


CALL(A) 






0853 


• 


5 


CALL 


CALL2 






0854 


• 


6 


CALL 


CALL2 (A,B,C) 






0855 


* 


7 


CALL 


SETSBV (A) 






0856 


• 


8 


CALL 


SETUP (A) 






0857 


• 


9 


CALL 


SETUP (A,B,C,D, 


E) 




0858 


• 


10 


CALL 


RETURN 






0859 


• 


11 


CALL 


RE TURN ( A,B,C,D) 






0860 


• 


12 


CALL 


STORE( A ,B,C,D, E ) 




0861 


• 


13 


CALL 


STORE! A, B ) 






0862 


ft 


OUTPUTS - PAUSE 


NO. 


AC* 


MQ= 


XR4= 


0863 


• 












0864 


• 


1 




434623216325 


000000000000 


ADDR. STATMNT 1 


0865 


« 


2 




663025512560 


000000000002 


PLUS 1 


0866 


« 


3 




DITTO 


000000000005 


PLUS 3 


0867 


• 


4 




232143436060 


000000000001 


PLUS 6 


0868 


* 


5 




232143430260 


000000000000 


PLUS 2 


0869 


« 


6 




DITTO 


000000000003 


PLUS 1 


0870 


• 


7 




622563622265 


000000000001 


PLUS 4 


0871 


• 


8 




622563644760 


000000000001 


PLUS 2 


0872 


• 


9 




DITTO 


000000000005 


PLUS 2 


0873 


• 


10 




512563645145 


ocoooooooooo 


PLUS 6 


0874 


• 


11 




DITTO 


000000000004 


PLUS 1 


0875 


• 


12 




626346512560 


000000000005 


PLUS 5 


0876 


« 


13 




DITTO 


000000000002 


PLUS 6 


0877 


• 






(ADD 2 TO 


THE PLUS*S IF 


STD. ERR. PROC.) 


0878 



USAGE 



DIMENSION IANSC8), L0C(8), NARGS(8) 
DO 10 1=1,8 



0879 
0880 
0881 
0882 
0883 
0884 
0885 
0886 
0887 
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« 






IANS(I)=-99 


0888 


* 






LOC(I) =-99 


0889 


• 




10 


NARGS(I)=-99 


0890 


• 




1 


CALL WHERE (6HANYSUBt IANS( 1 ) »LOC ( 1 ) f NARGS! 1 ) ) 


0891 


• 






CALL LOCATE( 6HL0CATE »6HL0CDUM ) 


0892 


• 






CALL LOCATE! A, B,C) 


0893 


* 






CALL LOCATE 


0894 


• 




2 


CALL WHERE !6HL0CATE,IANS!2) ,LOC (2) ,NARGS(2) ) 


0895 


• 




3 


CALL WHERE(6HL0CDUM,IANS(3),L0C(3),NARGS(3) ) 


0896 


• 




4 


CALL WHEREC6HANYSUB, IANS(4) ,LOC ( 4 ) , NARGS! 4) ) 


0897 


• 






CALL LOCATEt 5HWHERE»6H DUM2) 


0898 


• 






CALL WHERE!A,B,C,D,E,F f G,H f I, J, K, L,M,N,0, P) 


0899 


• 






A=B 


0900 


• 




5 


CALL WHERE ( 6H WHERE , IANS! 5 ) ,LOC ( 5 ) ,NARGS ( 5 ) ) 


0901 


• 




6 


CALL WHERE (4HDUM2, IANS! 6), LOC (6) , NARGS (6) ) 


0902 


• 






CALL LOCATE! DUM) 


0903 


* 






A=B 


0904 


• 






CALL LOCATE ( DUM ) 


0905 


* 






A=B 


0906 


• 






CALL LOCATE! DUM) 


0907 


• 






A=B 


0908 


• 






( ETC t 


0909 


• 






13 PAIRS IN TOTAL) 


0910 


• 






CALL LOCATE! DUM) 


0911 


* 






A=B 


0912 


• 




7 


CALL WHERE! 6HL0C ATE » IANS!7) ,LOC (7) ,NARGS(7) ) 


0913 


• 




8 


CALL WHERE (5HWHERE, IANS !8),L0C!8), NARGS! 8)) 


0914 


* 








0915 


• 


OUTPUTS 


- 1 = 


lANS(I)* LOCil)* NARGS! I)= 


0916 


* 




I 


-3 -99 -99 


0917 


* 




2 


0 ADDRESS (LOCATE) 3 


0918 


• 




3 


0 SAME AS LOC! 2) 0 


0919 


• 




4 


-1 -99 -99 


0920 


• 




5 


0 ADORE SS ( WHERE ) (GRTHN L0C(2)) 16 


0921 






6 


-2 -99 -99 


0922 


* 




7 


-4 -99 -99 


0923 


* 




8 


0 SAME AS LOC! 5) 16 


0924 


• 








0925 


• 








0926 


• 


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 


0927 


* 








0928 


• 


3. EXAMPLE 


OF PROXY CALL STATEMENTS BY CALL AND CALL2 (WITH AND 


0929 


* 


WITHOUT 


SETSBV) 




0930 


* 








0931 


• 


INPUTS 


- SUPPOSE THE SUBROUTINE TO BE PROXIED HAS THE FUNCTION OF 


0932 


* 




SETTING ITS SECOND ARGUMENT * TWICE ITS FIRST ARGUMENT 


0933 


• 




AS FOLLOWS 


0934 


• 






SUBROUTINE DUBLER(I,K) 


0935 


• 






K=2»I 


0936 


* 






RETURN 


0937 


• 






END 


0938 


* 








0939 


• 


USAGE 




DIMENSION SUBRUV(6) , ISUBRV(6) ,C0M(2 ) , I ANS(8) ,K( 8) 


0940 


• 






EQUIVALENCE ( SUBRUV, ISUBRV) 


0941 


• 






COMMON COM 


0942 


* 






CALL LOCATE! 6HDUBLER ) 


0943 


* 






CALL DUBLER 


0944 


• 




C FIRST TRY REPEATED USE OF CALL CALL 


0945 


« 






DO 10 J»l,3 


0946 


• 






I=J 


0947 


« 






CALL CALL(6HDUBLER t I ANS( I ) # SPACER, I ,K{ J ) ) 


0948 


» 




10 


CONTINUE 


0949 


• 




C NOW 


SET UP A SUBROUTINE VECTOR THE HARD WAY 


0950 


* 






SUBRUV! 1)=6HDUBLER 


0951 


• 






ISUBRV!2)=2 


0952 


• 




B 


SUBRUV! 3)=777777777777 


0953 


* 






I SUBR V ( 4 ) =XLOCF ! COM ) -XL OCF ! I ) + 1 


0954 


* 






ISUBRV! 5 )-XLOCF!COM)-XLOCF! KTEMP )+l 


0955 


• 




B 


SUBRUV (6)=777777777777 


0956 


• 




C THEN TRY REPEATED USE OF CALL2 FROM THE SAME STATEMENT 


0957 


• 






DO 20 J=4 f 6 


0958 


• 






I=J 


0959 


• 






CALL CALL2! SUBRUV t IANS! J) ) 


0960 


• 






Kt J)=KTEMP 


0961 


* 




20 


CONTINUE 


0962 
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* C NOW TRY IT FROM ANOTHER SPOT WITH THE SAME SUBRUV 0963 
» C VECTOR 0964 

* 1*7 0965 
« CALL CALL2(SUBRUV,IANSCT)) 0966 

* K(7)=KTEMP 0967 

* C NOW REESTABLISH SUBRUV THE EASY WAY ANO RETRY CALL2 0968 
« CALL SETSBV( 6HDUBLER, SUBRUV, 8, K(8) ) 0969 

* CALL CALL2(SUBRUV,IANSC8)) 0970 

* 0971 

* 0972 

* OUTPUTS - IANS(1...8)=0 0973 

* Ml... 8) =2, 4, 6, 8, 10, 12, 14, 16 0974 

* 0975 

* 0976 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 0977 

* 0978 

* 4. EXAMPLES OF SETUP AND RETURN 0979 

* 0980 
« INPUTS - SUPPOSE C0UNT1 IS A SUBROUTINE WHICH SETS ITS FIRST 0981 
« ARGUMENT EQUAL TO ITS ARGUMENT COUNT (PROVIDED THE 0982 

* COUNT IS NON-ZERO) 0983 
« SUBROUTINE C0UNT1 ( ICOUNT ) 0984 
« CALL SETUP(LOCALL, NARGS, XR1,XR2) 0985 

* IF (NARGS) 20,20,10 0986 

* 10 ICOUNT=NARGS 0987 

* 20 CALL RETURN( LOCALL , XR1 , XR2 ) 0988 

* END 0989 

* 0990 

* USAGE - DIMENSION IC0UNT(3) 0991 

* DO 10 1=1,3 0992 

* 10 ICOUNT(I)=0 0993 
« CALL COUNTK ICOUNT( 1 ) , A,B,C,D,E,F) 0994 
» CALL C0UNT1 0995 
« CALL COUNTK IC0UNT(3)) 0996 

* 0997 
« OUTPUTS - IC0UNTU...3) = 7,0,1 0998 

* 0999 

* 1000 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 1001 

* 1002 

* 5. EXAMPLE OF SETUP, RETURN, XINDEX, XARG AND STORE 1003 

* 1004 

* INPUTS - SUPPOSE A VARIABLE-LENGTH-CALLING-SEQUENCE SUBROUTINE, 1005 
» ADARGS, HAS THE FUNCTION OF SETTING THE FIRST ELEMENT OF 1006 

* ITS FIRST ARGUMENT * NO. OF ITS ARGUMENTS, AND THE 1007 
» SECOND ELEMENT - SUM OF THE REMAINING ARGUMENTS. IT WILL 1008 

* COMPUTE TWO WAYS, USING XARG AND XINDEX, AND COMPARE 1009 

* BEFORE STORING. IT WILL EXIT FOR LESS THAN TWO ARGUMENTS. 1010 
« SUBROUTINE ADARGS 1011 
« DIMENSION IC0MC2) 1012 

* COMMON ICOM 1013 
« CALL SE TUP (LOCALL, NARGS, XR1 ,XR2) 1014 

* IF (NARGS-2) 99,10,10 1015 

* C FIRST COMPUTE USING XARG 1016 

* 10 ITEMP1=0 1017 
« DO 20 1=2, NARGS 1018 

* 20 ITEMP1=ITEMP1*XARGF(L0CALL,I,1) 1019 

* C THEN USE XINDEX AND COMPARE RESULTS 1020 

* ITEMP2=0 1021 
« DO 30 1=2, NARGS 1022 
« IX=XINOEXF(LOCALL,I) 1023 
« 30 ITEMP2=ITEMP2+ICOM(IX) 1024 

* IFC ITEMP1-ITEMP2) 99,40,99 1025 
» C SET OUTPUTS WITH STORE 1026 
« 40 CALL STORE(NARGS, LOCALL, 1,1) 1027 
« CALL STOREUTEMPi, LOCALL, 1,2) 1028 

* 99 CALL RETURN ( LOCALL , XR1 , XR2 ) 1029 

* END 1030 
« 1031 

* USAGE - DIMENSION IA (2) , IB( 2) , IC(2) 1032 

* DO 10 1=1,2 1033 

* IA(I)=-99 1034 
» IB(I)=-99 1035 

* 10 IC(I)=-99 1036 
« CALL ADARGS( IA,1,2,3,4) 1037 
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» CALL ADARGS( IB,1) 1038 

» CALL AOARGS(IC) 1039 

» CALL AOARGS 1040 

* 1041 

* OUTPUTS - IA(1,2) = 5,10 IB(1,2)= 2,1 ICC1,2)= -99,-99 1042 

* 1043 
« 1044 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 1045 
« 1046 
» 6. EXAMPLE OF TWO-WAY DIRECT COMMUNICATION THRU AN INTERMEDIATE 1047 

* SUBROUTINE, USING SETUP, RETURN, XNARGS, XNAME , STORE 1048 
« 1049 

* INPUTS - SUPPOSE SUBROUTINE PASSER MERELY TRANSMITS ITS LOCALL, 1050 

* XR1 AND XR2 VALUES TO NAMECK 1051 
« SUBROUTINE PASSER 1052 
« CALL SETUPIL0CALL,NARGS,XR1,XR2) 1053 
« CALL NAMECK ( LOCALL , XRI , XR2) 1054 
» END 1055 

* AND NAMECK HAS THE FUNCTION OF SETTING THE FIRST 1056 

* ARGUMENT (RELATIVE TO LOCALL) EQUAL 1 OR -1 ACCORDING 1057 
« TO WHETHER OR NOT THE REMAINING ARGUMENTS (ASSUMING AT 1058 
» LEAST 3 TOTAL) ALL REPRESENT THE SAME HOLLERITH NAME, 1059 

* AND THEN SKIP RETURNING. 1060 
« SUBROUTINE NAMECK ( LOCALL , XRI, XR2 ) 1061 

* NARGS « XNARGSFC LOCALL) 1062 
« HNAME1 = ARGFC LOCALL, 2, 1 ) 1063 

* 00 10 1=3, NARGS 1064 
« HNAMET * ARGF (LOCALL ,1,1) 1065 

* IF (XNAMEF(HNAME1, HNAMET)) 20,10,10 1066 

* 10 CONTINUE 1067 

* CALL STORE (1 , LOCALL, 1,1) 1068 

* GO TO 99 1069 
» 20 CALL ST0RE(-1, LOCALL, 1,1) 1070 

* 99 CALL RETURNC LOCALL , XRI , XR2 ) 1071 

* END 1072 
» 1073 
» USAGE - CALL PASSER ( I ANSI , 3H*A4,4H »A4,5H »A4,6H *A4) 1074 

* CALL PASSER (IANS2,6H / /,3H/ /) 1075 

* CALL PASSER ( I ANS3, 6HABCDEF ,6HABC0EE ) 1076 
« 1077 

* OUTPUTS - IANS1 » 1 IANS2 = 1 IANS3 = -1 1078 
» 1079 

* 1080 
« XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 1081 
» 1082 

* 7, EXAMPLE OF A GENERAL PURPOSE SUBROUTINE 1083 

* 1084 

* INPUTS - SUPPOSE SUBROUTINE GNPURP MERELY OPERATES, USING CALL2, 1085 

* AN ARBITRARY NUMBER OF SUBROUTINE VECTORS PASSED TO IT 1086 

* AS ARGUMENT NOS. 2,3,... BUT REPORTS BACK, IN ITS FIRST 1087 

* ARGUMENT (VECTOR) THE IANS RESULT OF CALL2 FOR EACH 1088 

* SUBROUTINE 1089 
» SUBROUTINE GNPURP(IANS) 1090 
« DIMENSION IANSI2),C0M(2) 1091 
» COMMON COM 1092 
« CALL SE TUP! LOCALL, NARGS , XRI ,XR2 ) 1093 
« IF (NARGS-1) 99,99,10 1094 
« 10 DO 20 1=2, NARGS 1095 
« IX * XINDEXF(LOCALL,I) 1096 

* J=I-1 1097 

* 20 CALL CALL2(C0M( IX) , IANSi J) ) 1098 

* 99 CALL RETURNC LOCALL, XRI , XR2) 1099 

* END 1100 

* 1101 

* AND SUPPOSE SUBROUTINES DUBLER,C0UNT1 ,ADARGS, PASSER AND 1102 

* NAMECK ARE AS DEFINED PREVIOUSLY 1103 
« 1104 
« USAGE - DIMENSION SUBRVD ( 6 ) , SUBRVCC 9) , SUBRVA( 12 ) , SUBRVP ( 7 ) , 1105 
» ISUM(2),IANS(4) 1106 

* CALL LOCATE( 6HDUBLER,6HC0UNT1 ,LHADARGS, 6HPASSER ) 1107 
« CALL DUBLER 1108 
« CALL C0UNT1 1109 

* CALL ADARGS 1110 

* CALL PASSER 1111 

* C (NOTE-NAMECK DOESNT NEED TO BE LOCATED, BUT IS NEEDED 1112 
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* C FOR EXECUTION) 1113 

* CALL SETSBV(6H0UBLER,SUBRVD,16, IDUBL) 1114 
« CALL SETSBV(6HC0UNT1,SUBRVC, ICOUNT, A, B,C,D) 1115 

* CALL SETSBV<6HA0ARGS,SUBRVA,ISUM,3,5,7, 11,13,17, 19) 1116 

* CALL SETSBV(6HPASSER,SUBRVP,IANSP,4HSAME,6H SAME) 1117 

* CALL GNPURP< IANS,SUBRVO, SUBRVC, SUBRVA, SUBRVP ) 1118 

* 1119 
» OUTPUTS - IANSU...4) » 0 (MEANING ALL SUBROUTINES FOUND) AND 1120 

* IDUBL « 32 ICOUNT * 5 ISUMI1...2) * 8,75 IANSP = 1 1121 
« 1122 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 1123 

* 1124 
» 8. EXAMPLE OF USE OF SETUP AND RETURN FOR LOOP LOGIC BETWEEN 1125 

* SUBROUTINES - A CALLS B, B CALLS C, C CALLS B, B RETURNS TO C, 1126 
« C CALLS B, B RETURNS TO A. 1127 

* 1128 

* INPUTS - SUPPOSE SUBROUTINES ADD1 AND ADD7 MERELY ADD 1 AND 7 1129 

* RESPECTIVELY TO THEIR FIRST ARGUMENTS. ( ADD1 AND ADD7 1130 

* WILL PLAY THE ROLES OF SUBROUTINES B AND C ABOVE 1131 

* RESPECTIVELY. ADD1 WILL HAVE THE PRIMARY LOGIC 1132 
» RESPONSIBILITIES.) 1133 

* 1134 

* SUBROUTINE ADDl ( ISUM, CALLER) 1135 

* CALL SETUP(L0CTMP,NARGS,XR1TMP,XR2TMP) 1136 

* ISUM=ISUM*1 1137 

* C NOW FIND OUT WHO IS CALLING 1138 
« SUBAD7=4HADD7 1139 

* IF (XNAMEF(SUBAD7, CALLER)) 10,20,20 1140 

* C IF NOT ADD7 SET ASIDE LOCTMP, XR1TMP, XR2TMP, 1141 
« C INITIALIZE COUNTER AND THEN CALL ADD7 1142 

* 10 LOCBAK*LOCTMP 1143 

* XR1BAK=XR1TMP 1144 
» XR2BAK=XR2TMP 1145 
» IC0UNT=1 1146 

* CALL ADD7USUM) 1147 

* C IF IT IS A0D7, RETURN TO CALLING PROGRAM IF ICOUNT 1148 

* C HAS REACHED 2. 1149 

* 20 IF (ICOUNT-2) 40,30,30 1150 

* 30 CALL RETURN ( LOCBAK, XR1BAK,XR2BAK ) 1151 
» C IF ICOUNT IS STILL * 1, INCREASE IT BY 1 AND RETURN TO 1152 
« C ADD7. 1153 
» 40 IC0UNT=IC0UNT+1 1154 
» RETURN 1155 

* C NOTE - ABOVE STATEMENT IS EQUIVALENT TO 1156 

* C CALL RETURN ( LOCTMP, XR1TMP, XR2TMP) 1157 

* END 1158 
» 1159 

* SUBROUTINE ADD7USUM) 1160 

* ISUM=ISUM+7 1161 
« CALL ADDl(ISUM,6H ADD7) 1162 

* ISUM=ISUM+7 1163 

* CALL ADDl(ISUM,5H ADD7) 1164 

* RETURN 1165 
« C (NOTE - ABOVE RETURN STATEMENT WILL NEVER BE EXECUTED) 1166 

* END 1167 
« 1168 

* USAGE - ISUM*0 1169 

* CALL ADDl ( ISUM,4HMAIN) 1170 
» 1171 

* OUTPUTS - ISUM=17 (I.E., 3 CALLS OF ADDl, 1 CALL OF ADD7 AND 1 1172 

* RETURN TO ADD7 ) 1173 

* 1174 

* 1175 

* 1176 
« XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 1177 
« 1178 

* PROGRAM FOLLOWS BELOW 1179 

* 1180 

* 1181 
« 1182 
« XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY LOCATE ( SUBRU1 ,SUBRU2, ... ) 1183 

* 1184 
« 1185 

HTR 0 1186 

HTR 0 1187 
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HTR 


0 








1188 




BCI 


1, LOCATE 








1189 


LOCATE 


SXD 


LOCATE-4,1 








1190 




CLS 


Kl 








1191 




TSX 


EXCHQR.l 








1192 


* SEE 


IF THIS 


XR4 VALUE IS ALREADY IN TABLE 








1193 




PXA 


0,4 








1194 




LXA 


NKEYS, 2 








1195 




TXL 


NEWKEY, 2,0 NOT IF NKEYS*0 








1196 


CASL 


CAS 


KEYS+1,2 








1197 




TRA 


*+2 








1198 




TRA 


LBACK YES IT IS 








1199 




TIX 


CASL, 2,1 








1200 


« PUT 


XR4 IN 


TABLE IF IT IS NEW, 








1201 


• ANO 


INDEX NKEYS AND NXKEY BY 1, 








1202 


» BUT 


PREVENT 


NKEYS FROM EXCEEDING KTABLE (SET KOVER IF IT TRIES TO), 


1203 


« AND 


RESET NXKEY TO 1 WHEN IT REACHES KTABLE+1 








1204 


NEWKEY 


LXA 


NXKEY, 1 








1205 




STA 


KEYS+1,1 








1206 




CLA 


NXKEY 








1207 




ADD 


Kl 








1208 




STO 


NXKEY 








1209 




LDQ 


Kl 








1210 




CAS 


KTABLE 








1211 




STQ 


NXKEY 








1212 




NOP 










1213 




CLA 


NKEYS 








1214 




ADD 


Kl 








1215 




CAS 


KTABLE 








1216 




STQ 


KOVER 








1217 




TRA 


•+3 KTABLE OR KTABLE+1 








1218 




STO 


NKEYS 








1219 




TRA 


LBACK 








1220 




NZT 


KOVER WHICH IS IT 








1221 




STO 


NKEYS 








1222 


• NOW 


GET INTERNAL SUBROUTINE SKIP TO HELP US GET 


BACK 






1223 


« FIRST JUMP 


GIVES NO. ARGUMENTS OF THE TSX $L0CATE,4. 






1224 


» IF MQ NEG» 


EXIIT TO 1,4. OTHERWISE, SKIP NARGS TIMES OR 


UNTIL 


1225 


• MQ GOES NEGATIVE, WHICHEVER FIRST. 








1226 


LBACK 


TSX 


SKIP,1 








1227 




TQP 


•♦2 








1228 




TRA 


LEXIT 








1229 




PAX 


0,2 








1230 


JUMP1 


TXI 


♦♦1,4,-1 








1231 




TSX 


SKIP,1 








1232 




TQP 


»+2 








1233 




TRA 


LEXIT 








1234 




TIX 


JUMP1,2,1 








1235 


LEXIT 


LXD 


LOCATE-4,1 








1236 




LXD 


LOCATE-3,2 








1237 




TRA 


lt4 








1238 


• 












1239 


• 












1240 


« XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY WHERE (SUBRU, 


IANS, 


LOC, NARGS) 


1241 


• 












1242 


• 












1243 


« THE 


IANS OUTPUT OF WHERE IS 








1244 


* 


* 0 


IF LOCATED OK. 








1245 


• 


=-1 


NOT LOCATED, BUT THE TABLES ARE IN 


ORDER. 






1246 


« 


*-2 


NOT LOCATED. IT WAS FOUND AS ONE OF 


THE ARGUMENTS OF 


1247 


• 




A CALL LOCATE STATEMENT, BUT THE 


ASSOCIATED 




1248 


• 




LIST OF CALL STATEMENTS WAS TOO 


SHORT. 






1249 


• 




NOT LOCATED, NO CALL LOCATE STATEMENT HAS 


BEEN 


MADE YET. 


1250 


• 




NOT LOCATED, BUT THE KEYS LIST HAS 


OVERFLOWED, 




1251 


* 




AND IT MAY HAVE BEEN LOST FROM A 


PRIOR 






1252 


* 




CALL LOCATE STATEMENT. 








1253 


* 












1254 


• 












1255 




BCI 


1, WHERE 








1256 


WHERE 


SXD 


LOCATE-4,1 








1257 




CLA 


K4 








1258 




TSX 


EXCHQR,1 








1259 


* LEFT 


ADJUST 


THE NAME 








1260 




LDQ* 


1,4 6HSUBR0U 








1261 




TSX 


ADJUST, 1 








1262 
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STO SUBROU 1263 

CLA 3,4 A(LOC) 1264 

STA STOWl 1265 

CLA 4,4 A(NARGS) 1266 

STA STOW2 1267 

• IMMEDIATE EXIT WITH IANS=-3 IF NKEYS=0 1268 

ZET NKEYS 1269 

TRA GOTAK 1270 

CLS KD3 1271 

• EXIT CHANNEL (ALSO USED BY CALL, CALL2) 1272 
LEAVEW LXD LOCATE-2,4 1273 

STO« 2,4 1274 

TRA SKIPEX 1275 

» OTHERWISE INITIALIZE IXKEY*0 AND START 1276 

GOTAK STZ IXKEY 1277 

« INDEX IXKEY AND CHECK IF IT EXCEEDS NKEYS 1278 

NXTKEY CLA IXKEY 1279 

ADD Kl 1280 

STO IXKEY 1281 

CAS NKEYS 1282 

TRA GIVUP 1283 

NOP 1284 

TRA KEYOK 1285 

» IF SO SET IANS*-1 IF KOVER^O 1286 

• =-4 IF KOVER^l, AND EXIT. 1287 
GIVUP CLS KD1 1288 

NZT KOVER 1289 

TRA LEAVEW 1290 

CLS KD4 1291 

TRA LEAVEW 1292 

• GET THIS KEY AND SET XR4 AND LARG WITH IT 1293 
KEYOK PAX 0,2 1294 

CLA KEYS+1,2 1295 

PAX 0,4 (SET FOR LATER SKIPPING) 1296 

PAC 0,2 1297 

SXA LARG, 2 1298 

• RUN DOWN THE ARGUMENTS OF LOCATE, UNTIL A NON-TSX X,0 1299 

• INSTRUCTION IS REACHED. XR2 KEEPS NEGATIVE TRACK OF ARG NO. 1300 

AXC 1,2 1301 

LARG CAL *»,2 *»*A(TSX $L0CATE,4) 1302 

STA GOTARG 1303 

TSX CKTSXZ,1 1304 

TRA NXTKEY 1305 

• FOR EACH TSX X,0 GET THE ARGUMENT AND COMPARE WITH SUBROU. 1306 
« BACK TO TRY NEXT ARGUMENT IF DOESNT MATCH 1307 
GOTARG LDQ *» »»*A(A(TSX $LOCATE ,4) -XR2 ) XR2=-ARG NO. 1308 

TSX ADJUST, 1 1309 

STQ TEMP 1310 

CAL TEMP 1311 

LAS SUBROU 1312 

TRA *+2 1313 

TRA MATCH 1314 

TXI LARG, 2,-1 1315 

• WHEN IT MATCHES, -(XR2)*INDEX OF THE MATCHING ARG 1316 

• GET THIS INDEX AND USE SKIP THIS MANY TIMES 1317 
« TO LOCATE THE CORRESPONDING TSX $SUBR0U,4 1318 
« BUT ERROR EXIT IF SKIP HITS A NON SPECIAL INSTRUCTION 1319 

MATCH PXA 0,2 1320 

PAC 0,2 1321 

SKP TSX SKIP,1 1322 

TOP CONTIN 1323 

CLS KD2 1324 

TRA LEAVEW 1325 

CONTIN TXI •♦1,4,-1 1326 

TIX SKP, 2,1 1327 

• FIGURE OUT THE SUBROUTINE ENTRY POINT AND SET LOC. 1328 
« ENTRY POINT = ADDRESS PORTION OF THAT REGISTER (IN THE TRANSFER 1329 
« VECTOR) WHOSE AOORESS IS THE ADDRESS PORTION OF THE 1330 
» TSX *SUBR0U,4 WHICH SKIP JUST STOPPED AT. 1331 
« (NOTE ADVANCE OF XR4 BY 1 AT CONTIN) 1332 

CLA 0,4 PICKS UP TSX $SUBR0U,4 1333 

STA *+l 1334 

CAL ** 1335 

ANA MSK3 1336 

ALS 18 1337 
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STOW1 SLW «• »*=A(LOC) 1338 

« USE SKIP AGAIN TO GET THE ARGUMENT COUNT. SET IANS*0. EXIT. 1339 

TSX SKIP,1 1340 

ALS 18 1341 

ST0W2 STO *» »**A(NARGS) 1342 

CLA KO (SET IANS) 1343 

TRA LEAVEW 1344 

» 1345 

* 1346 
« XXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY CALL ( SUBRU, IANS , SPACER, ARG1, ARG2, ... ) 1347 
« 1348 
« 1349 
« CALL LEAVES IANS * 0 IF EVERYTHING OK 1350 
« * SAME AS FROM WHERE IF CANT FIND SUBROUTINE 1351 

* (-1,-2,-3,-4) 1352 

* 1353 
« SET WHICH CALL INDICATOR ICALL * 0 FOR CALL 1354 

* 1355 
BCI I, CALL 1356 

CALL SXD LOCATE-4,1 1357 

* CALL MUST HAVE AT LEAST 2 ARGUMENTS AND 3,4 MUST BE SOME KIND OF A 1358 
« TSX (TSX X,4 ON REPEAT ENTRY ) 1359 

CLS K2 1360 

CKCALL TSX EXCHQR,1 1361 

STZ ICALL 1362 

CAL 3,4 1363 

TSX CKTSXA,1 1364 

TRA CKCALL (WITH AC HUGE,NEG OR POS) 1365 

TRA LXDCC2 1366 

» 1367 

* 1368 
» XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY CALL2 ( SUBRUV, IANS ) 1369 
» 1370 
« 1371 
« CALL2 LEAVES IANS » 0 IF EVERYTHING OK 1372 
« = SAME AS FROM WHERE IF SUBROUTINE NOT FOUND 1373 

* (-1,-2,-3,-4) 1374 

* * -5 IF FIRST CALL2 WITH THIS SUBRUV BUT SOMETHING 1375 

* IS ILLEGAL ABOUT SUBRUV 1376 

* (CONSIDERED FIRST CALL I.F.F. SUBRUV( 3 ) =FENCE ) 1377 
« = -6 IF SECONDARY CALL2 WITH THIS SUBRUV BUT 1378 

* SOMETHING IS ILLEGAL ABOUT SUBRUV 1379 

* 1380 

* 1381 
« SET ICALL NON-ZERO (=XR4) FOR CALL2 1382 

* 1383 
BCI 1,CALL2 1384 

CALL2 SXD LOCATE-4,1 1385 

CLA K2 1386 

TSX EXCHQR,1 1387 

SXA ICALL, 4 1388 

* THESE TWO CALLS RUN TOGETHER UNTIL THE SUBROUTINE IS FOUND 1389 
LXDCC2 LXD LOCATE-4,1 1390 

SXA AXT4W,4 1391 

CLA 1,4 A(6HSUBR0U=SUBRUV(1)) 1392 

STA TSXW1 1393 

SUB Kl 1394 

STA NGET 1395 

SUB Kl 1396 

STA GTFNCE 1397 

STA CALC2 1398 

STA CLAR 1399 

STA LDQR 1400 

CLA 2,4 A(IANS) 1401 

STA ANSET 1402 

NGET CLS *» »**A(NARGS) (CALL2) 1403 

ARS 18 1404 

ADD 1,4 1^05 

SUB K3 A( SUBRUV (NARGS+4) ) 1406 

STA STTSX4 1407 

* USE WHERE TO FIND SUBROUTINE AND IANS (IT ALSO SAVES 6HSUBR0U) 1408 
« AND THEN CHECK IANS 1409 
« (NOTE XR1 AND XR2 HAVE ORIGINAL VALUES AT THIS POINT.) 1410 

TSX WHERE, 4 1411 

TSXW1 TSX **,0 «»=A(6HSUBR0U) 1412 
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TSX 


TEMP2,0 


IANS 








1413 


TSX 


LOCO 










1414 


TSX 


TEMP3,0 


(DUMMY FOR NARGS) 








1415 


CLA 


TEMP2 










1416 


AXT4W AXT 


**,4 










1417 


SXO 


LOCATE-2,4 










1418 


TNZ 


LEAVEW 










1419 


* IF OK, FORK 


ON CALL TYPE 










1420 


ZET 


ICALL 










1421 


TRA 


NTCALL 










1422 


* FOR CALL SET 


ADDRESS OF THE TSX LOC, 4 = 3,4 








1423 


LOC 


LOCATE-2,4 










1424 


TXI 


♦♦1,4,3 










1425 


SXA 


STTSX4,4 










1426 


* THIS IS WHERE CALL AND CALL2 TRANSFER TO SUBROU (SETTING 


IANS«0) 


1427 


FUNEL LXD 


LOCATE-4,1 










1428 


LXD 


LOCATE-3,2 










1429 


CLA 


KO 










1430 


ANSET STO 


»» 


**=A(IANS) 








1431 


CLA 


LOC 










1432 


ARS 


18 










1433 


ADO 


TSX4 










1434 


STTSX4 STO 


•* 


***A(TSX LOC, 4) 








1435 


TRA* 


STTSX4 










1436 


* IF SUBRUVC3) 


IS NOT 777,.. 


ASSUME THAT THIS IS A 








1437 


* REPEAT ENTRY 


WITH THE SAME 


SUBRUV VECTOR AND 








1438 


* 1. SUBRUVO) » TRA X 


(BUT X MUST BE RESET) 








1439 


* 2. SUBRUV(4, 5,...,NARGS+3) IS STILL SET UP FROM 


LAST 


CALL2 


1440 


« 3. SU8RUV(NARGS*4I IS 


STILL TSX Y,4 (BUT Y MUST 


BE RESET) 


1441 


NTCALL CLA* 


NGET 


« NARGS 








1442 


GTFNCE CAL 


»• 


***A( SUBRUV (3)) = FENCE 


OR 


TRA 


X 


1443 


LAS 


FENCE 










1444 


HPR 


CALL2-1 


(MACHINE ERROR OR FENCE 


SMASHED) 


1445 


TRA 


• ♦2 


NEW 








1446 


TRA 


REPEAT 










1447 


* OTHERWISE WE 


WANT TO REVERSE AND CONVERT 








1448 


* SUBRUV(4..., 


NARGS+3) , PROVIDED NARGS I SNT ZERO, 








1449 


* AND THEN SET 


LINKAGE IN SUBRUVO) 








1450 


* FIRST CHECK 


FENCE IN SUBRUV(NARGS+4) 








1451 


CAL* 


STTSX4 


* SUBRUV(NARGS+4) 








1452 


LAS 


FENCE 










1453 


TRA 


• ♦2 










1454 


TRA 


*+? 










1455 


TRA 


BADSBV 










1456 


* IF OK CHECK 


FOR NEG OR ZERO NARGS 








1457 


CLA* 


NGET 










1458 


TZE 


RVOVR 










1459 


TPL 


REV 










1460 


* EXIT WITH IANS=-5 FOR ILLEGAL SUBRUV 








1461 


BADSBV CLS 


KD5 










1462 


TRA 


LEAVEW 










1463 


* FOR A REPEAT 


ENTRY, CHECK 


THAT WE STILL HAVE TRA X, 








1464 


* NARGS IS NON-NEG, AND THE 


TSX*S ARE STILL THERE 








1465 


REPEAT ANA 


MSK1 










1466 


LAS 


TRAZ 










1467 


TRA 


*+2 










1468 


TRA 


TRAOK 










1469 


CHANGE CLS 


KD6 










1470 


TRA 


LEAVEW 










1471 


TRAOK CLA* 


NGET 










1472 


TMI 


CHANGE 










1473 


ADD 


KD1 


(ALWAYS HAVE A TSX Y,4) 








1474 


PDX 


0,2 










1475 


CALC2 CAL 


**,2 


** = A(SUBRUV(3)) 








1476 


TSX 


CKTSXA,1 










1477 


TRA 


CHANGE 










1478 


TIX 


CALC2,2,1 










1479 


TRA 


RVOVR 










1480 


* FORM (NARGS+D/2 (TO CATCH 


MIDDLE TERM IF ODD) 








1481 


* AND SET XR1 


TO WORK ON HIGH END (LOW ADDRESSES) 








1482 


« AND XR2 


TO WORK ON LOW 


END (HIGH ADDRESSES) 








1483 


REV PDX 


0,1 


XR1*NARGS 








1484 


ADD 


KDl 










1485 


ARS 


1 










1486 


STD 


TXLR 










1487 
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AXT 


1,2 XR2»1 




1488 


• LOOP 


START 






1489 


CLAR 


CLA 


• »,2 »•=*( SUBRUV (3)) 




1490 


LOQR 


LDQ 


♦•,1 ♦♦»A(SU8RUV<3)) 




1491 


• CONVERT AND EXCHANGE AC AND MQ 




1492 




TSX 


CNVTACf 4 




1493 




XCA 






1494 




TSX 


CNVTAC.4 




1495 


« STORE THE 


VALUES AND INDEX FOR MORE 




1496 




STO» 


CLAR 




1497 




STQ« 


LDOR 




1498 




TXI 


•♦1,1,-1 




1499 




TXI 


♦♦1,2,1 




1500 


TXLR 


TXL 


CL AR , 2 , ** »«* ( NARG S* 1 ) /2 




1501 


« FINISHED REVERSING. 




1502 


• SET 1 


RETURN 


LINKAGE IN SUBRUVO), AND GO ENTER SUBROUTINE 


1503 


RVOVR 


LDC 


LOCATE-2,1 




1504 




TXI 


•♦1,1,3 




1505 




SXA 


TRA, 1 




1506 




CLA 


TRA TRA( A( TSX $CALL2 


,4)^3) 


1507 




STO* 


GTFNCE 




1508 




TRA 


FUNEL 




1509 


• 








1510 


• 








1511 


« XXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY SETSBVCSUBRU, SUBRUV, ARG1, ARG2, ... ) 


1512 


• 








1513 


« SETS SUBRUV! 1) * 6HSUBR0U 




1514 


« 




12) = NARGS 




1515 


* 




<3) » OCT 777777777777 ( = FENCE) 


1516 


• 




(4) » IXARG1 




1517 


• 




(5) = IXARG2 




1518 


• 




ETC 




1519 


« 




(N+4) = OCT 777777777777 




1520 


* 








1521 




BCI 


1, SETSBV 




1522 


SETSBV 


SXD 


LOCATE-4,1 




1523 




CLS 


K2 




1524 




TSX 


EXCHQR, 1 




1525 


« COUNT ARGUMENTS ( NARGS*COUNT-2) • 




1526 




TSX 


SKIP,1 




1527 




LXD 


LOCATE-2,4 




1528 




SUB 


K2 




1529 




PAX 


0,2 XR2»NARGS 




1530 


• SET : 


SU8RUV(1...3) 




1531 




CLA» 


1,4 6HSUBR0U 




1532 




STO* 


2,4 




1533 




CLA 


2,4 A(SUBRUVd)) 




1534 




SUB 


Kl 




1535 




STA 


STONRG A(SUBRUV(2) ) 




1536 




SUB 


Kl 




1537 




STA 


STOFNS Al SUBRUVO) ) 




1538 




STA 


STOIXA 




1539 




CLA 


FENCE 




1540 


STOFNS 


STO 


*• ♦•=A(SUBRUV(3) ) 




1541 




PXD 


0,2 




1542 


STONRG 


STO 


•• »»*A(SU8RUV<2))= 


A (NARGS) 


1543 


* THEN 


FILL 


IN SUBRUVI4...NARGS+3), IF NARGS 


NOT = 0. 


1544 




SXD 


TXLCAL, 2 




1545 




AXT 


1,2 SR2 STORES SUBRUV (4,5 , . . • ) 


1546 




TZE 


BAKFNS 




1547 




LDC 


LOCATE-2,1 A(TSX $SETSBV,4) 




1548 




TXI 


•+1,1,3 




1549 




SXA 


CALTRG, 1 




1550 




AXT 


0,1 XR1 PICKS UP TSX 


ARG1, TSX ARG2, ... 


1551 


CALTRG 


CAL 


•♦,1 ••=A(TSX ARG1,0) 




1552 




ANA 


MSK3 EXTRACT ADDRESS 




1553 




SSM 


AND 




1554 




ADD 


KC0MP1 CONVERT 




1555 




ALS 


18 




1556 


STOIXA 


STO 


•♦,2 ♦•=A( SUBRUV (3)) 




1557 




TXI 


•♦1,1,-1 




1558 




TXI 


•♦1,2,1 




1559 


TXLCAL 


TXL 


CALTRG, 2,** •♦*NARGS 




1560 


* ADD THE FINAL FENCE AT SUBRUV(NARGS+4) AND 


EXIT. 


1561 


BAKFNS 


CLA 


FENCE 




1562 
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STO» 


STOIXA 




1563 


TRA 


SKIPEX 




1564 


• 






1565 


• 






1566 


• XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY SETUP (LOCALL, NARGS, 


XR1,XR2) 


1567 


« 






1568 


« SETUP SETS LOCALL t XRl, XR2 FROM FIRST SXD X,4, SXD Y,l, 


SXD Z,2 


1569 


• 


ENCOUNTERED IN FRONT OF THE TSX $SETUP,4 




1570 


• 






1571 


BCI 


1, SETUP 




1572 


SETUP SXD 


LOCATE-4,1 




1573 


CLA 


K4 




1574 


TSX 


EXCHQR,l 




1575 


» FIRST GET AND SET XRl, XR2, L0CALL*-XR4 




1576 


AXT 


1,2 




1577 


TSX 


FNDXRS,1 




1578 


STO» 


3,4 XRl 




1579 


TSX 


FNDXRS,1 




1580 


STO* 


4,4 XR2 




1581 


TSX 


FNDXRS,1 




1582 


PDC 


0,1 




1583 


PXD 


0,1 




1584 


STO* 


1,4 LOCALL 




1585 


PDC 


0,4 -LOCALL TO XR4 FOR NARGS COUNT 




1586 


♦ THEN GET NARGS AND EXIT 




1587 


TSX 


SKIP,1 




1588 


ALS 


18 NARGS TO DECREMENT 




1589 


LXD 


LOCATE-2,4 




1590 


STO» 


2,4 NARGS 




1591 


TRA 


SKIPEX 




1592 


• 






1593 


* 






1594 


» XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY RETURN ( LOCALL, 


XR1,XR2) 


1595 


* 






1596 


» RETURNS 


CONTROL TO NEXT STATEMENT FOLLOWING TSX $SUB,4 AT 


LOCALL 


1597 


» RESTORES XRi AND XR2 (FROM DECREMENTS) 




1598 


* 






1599 


BCI 


1, RETURN 




1600 


RETURN SXD 


LOCATE-4,1 




1601 


CLA 


K3 




1602 


TSX 


EXCHQR,1 




1603 


CLA» 


2,4 XRl 




1604 


STD 


LOCATE-4 ( SAVED FOR SPCLEX TO RESTORE) 




1605 


CLA» 


3,4 XR2 




1606 


PDX 


0,2 




1607 


CLA» 


1,4 LOCALL 




1608 


POC 


0,4 




1609 


TRA 


SPCLEX 




1610 


« 






1611 


• 






1612 


* 






1613 


« XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY X I NDEX ( LOCALL 


, NUMARG) 


1614 


* 






1615 


* XINDEX FUNCTION SETS AC = INDEX WRT COMMON OF ARGUMENT NO. NUMARG 


1616 


• WHERE LOCALL » A(TSX $SUBR0U,4). NUMARG MAY BE NEGATIVE. 




1617 


• 






1618 


BCI 


1, XINDEX 




1619 


XINDEX SXD 


LOCATE-4,1 




1620 


TSX 


GETSXZ,1 




1621 


CLA 


TEMP 




1622 


SSM 






1623 


ADD 


KC0MP1 




1624 


ALS 


18 




1625 


EXITF LXD 


LOCATE-4,1 




1626 


TRA 


1,4 




1627 
1628 
1629 


• XXXXX ENTRIES ARG( LOCALL, NUMARG, I XVECT ) AND XARG ( LOCALL, NUMARG 


,IXVECT) 


1630 








1631 


» ARG FUNCTION 


AND XARG FUNCTION SET 




1632 


• AC = C( ADDRESS PORT ION I LOCALL+NUMARG )-I XVECT+1 ) 




1633 








1634 


BCI 


1, ARG 




1635 


ARG EQU 


• 




1636 


XARG SXD 


LOCATE-4,1 




1637 
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TSX GETSXZtl 1638 

STA *+l 1639 

CLA **=A(ARG) 1640 

TRA EXITF 1641 

* 1642 
« 1643 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY STORE! ARGU, LOCALL t NUMARG, IXVECT ) 1644 
» 1645 
« STORE PUTS ARGU IN THE REGISTER WHOSE ADDRESS 1646 
« = ADDRESS PORTION ( LOCALL+NUMARG) -IXVECT +1 1647 
« 1648 

BCI It STORE 1649 

STORE SXD LOCATE-4,1 1650 

CLA K4 1651 

TSX EXCHQR.l 1652 

* SET UP 77775, AC, MQ FOR GETSXZ 1653 

CLA* 4,4 IXVECT 1654 

STO 32765 1655 

CLA» 2,4 LOCALL 1656 

LDQ« 3,4 NUMARG 1657 

TSX GETSXZ, 1 1658 

STA *+2 1659 

CLA» 1,4 ARGU 1660 

STO »* *»=STORAGE ADDRESS FOR ARGU 1661 

TXI EXITF, 4, -4 1662 

* 1663 

* 1664 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY XNARGS ( LOCALL ) 1665 

* 1666 

* XNARGS FUNCTION LEAVES 1667 

* AC * NO. OF ARGUMENTS RELATIVE TO LOCALL 1668 

* * -1 IF LOCALL NOT = TSX X,4 1669 
« 1670 

BCI 1, XNARGS 1671 

XNARGS SXD LOCATE-4,1 1672 

SXD LOCATE-2,4 1673 

POC 0,4 1674 

« CHECK FOR TSX X,4 AT LOCALL 1675 

CAL 0,4 1676 

TSX CKTSX4,1 1677 

TRA CNTRGS 1678 

CLS KD1 1679 

LXDN LXD LOCATE-2,4 1680 

TRA EXITF 1681 

* THEN COUNT ARGUMENTS AND LEAVE 1682 
CNTRGS TSX SKIP,1 1683 

TRA LXDN 1684 

* 1685 

* 1686 
« XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY XNAME ( HNAME1 , HN AME2 ) 1687 

* 1688 
» 1689 

* FORTRAN FUNCTION COMPARING TWO HOLLERITH NAMES 1690 

* AC=*0 IF SAME, *-l IF DIFFERENT 1691 
» 1692 
» LEFT ADJUST THE TWO NAMES AND THEN COMPARE 1693 

BCI 1, XNAME 1694 

XNAME SXD LOCATE-4,1 1695 

STO TEMP2 1696 

TSX ADJUST, 1 1697 

STQ TEMP3 1698 

LDQ TEMP2 1699 

TSX ADJUST, 1 1700 

XCA 1701 

CAS TEMP3 1702 

TRA »+2 1703 

TRA SAME 1704 

» SET AC NEGATIVE IF DIFFERENT 1705 

CLS KD1 1706 

TRA »+2 1707 

* SET AC=0 IF THE SAME 1708 
SAME CLA KO 1709 

TRA EXITF 1710 

* 1711 

* 1712 
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* 


XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX INTERNAL SUBROUTINE EXCHQR 


1713 


* 








1714 


• 


SAVES INDEX REGISTERS 2 AND 4 AND CHECKS FOR LEGAL ARGUMENT COUNT 


1715 


• 


FOR 


AN ILLEGAL COUNT IT 


1716 


• 




1. SETS AC = 6HCNAME OF ENTRY INVOLVED) 


1717 


• 




2. SETS MQ » NO. ARGUMENTS (IN ADDRESS) 


1718 


• 




3. SETS XR4 = MACHINE ADDRESS OF ILLEGAL CALL STATEMENT 


1719 


• 




4. STOPS ON HPR 77777 


1720 


• 


IF RESTARTED 


IT WILL RETURN CONTROL TO CALLING PROGRAM 


1721 


« 








1722 


* 




LINKAGE 


WITH XR1 (RETURN TO 1,1) 


1723 


• 




ASSUMES 


AC ADDRESS) = LEGAL COUNT IF POSITIVE (MAY BE ZERO) 


1724 


« 






= MINIMUM LEGAL COUNT IF NEGATIVE 


1725 


• 




ASSUMES 


0,4 = CALLING STATEMENT 


1726 


• 




ASSUMES 


-3,1 = BCI 1 , (NAME OF ENTRY) 


1727 


• 




USES TEMP4, TEMPS, AND INTERNAL ROUTINE SKIP 


1728 


If 








1729 


EXCHQR 


SXD 


LOCATE-3,2 


1730 






SXD 


LOCATE-2,4 


1731 






SXA 


SAV1Q,1 


1732 






LDQ 


Kl 


1733 






STZ 


TEMP4 TEMP4 IS SWITCH 


1734 






TPL 


*+2 (ZERO FOR EXACT COUNT) 


1735 






STQ 


TEMP4 


1736 






SSP 




1737 






STO 


TEMP5 


1738 






TSX 


SKIP,1 


1739 






CAS 


TEMP5 


1740 






ZET 


TEMP4 


1741 






TRA 


SAV1Q 


1742 


• 


FOR 


ILLEGAL COUNT SET UP MQ, XR4, AC, AND PAUSE 


1743 






XCA 




1744 






LDC 


LOCATE-2,4 


1745 






LXA 


SAV1Q,1 


1746 






CLA 


-3,1 


1747 






HPR 


32767 


1748 


« 


GENERAL EXIT 


FUNNEL USING SKIP 


1749 


SKIPEX 


LXD 


LOCATE-3,2 


1750 






LXD 


LOCATE-2,4 


1751 


SPCLEX 


TSX 


SKIP,1 (USED BY RETURN) 


1752 






LXD 


LOCATE-4,1 


1753 






TRA 


1,4 


1754 


• 


GOOD 


COUNT 




1755 


SAVIO 


AXT 


»*,1 


1756 






LXD 


LOCATE-2,4 


1757 






TRA 


1,1 


1758 


* 








1759 


• 








1760 


« 


XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX INTERNAL SUBROUTINE SKIP 


1761 


« 








1762 


• 


SKIP 


TO NEXT 


TSX, 4 OR TO NON-SPECIAL INSTRUCTION, WHICHEVER FIRST 


1763 


* 








1764 


• 




LINKAGE 


WITH XR1, XR2 UNCHANGED 


1765 


• 




ASSUMES 


1,4 IS FIRST LOCATION TO BE CHECKED 


1766 


• 




LEAVES AC = NO* TSX X,0 INSTRUCTIONS PASSED THRU (IN ADDRESS) 


1767 


• 




STOPS WHEN FINDS AN INSTRUCTION 


1768 


* 




1. 


WHICH = TSX X,4 


1769 


« 




OR 2. 


WHICH IS NOT=TSX X,0 (NTR,PZE PAIRS IGNORED) 


1770 


* 




LEAVES 


MQ * PLUS FOR CASE !•, MINUS FOR CASE 2. 


1771 


* 




LEAVES 


1,4 = TSX X,4 FOR CASE 1. 


1772 


• 






= 1 BEYOND LAST TSX OF EITHER KIND FOR CASE 2, 


1773 


• 






(BUT WONT BACK UP PAST ORIGINAL 1,4) 


1774 


* 


EXAMPLES - 




1775 


* 




SUPPOSE 


ON INPUT 0,4*TSX A,B WHERE B IS ARBITRARY 


1776 


* 




LET NSI= 


*NON SPECIAL INSTRUCTION, ANY=ANY I NSTRUCTI ON, X , Y ARBITRARY 


1777 


* 




THEN SAMPLE OUTPUT SETTINGS OF XR4 ARE 


1778 


• 








1779 


« 




CASES WITH NO TSX X,0 FOUND 


1780 


« 






TSX A,B 


1781 


• 






NTR 


1782 


* 




0,4 


TSX A,B TSX A,B TSX A,B PZE 


1783 


• 




1,4 


NSI NTR TSX X,4 TSX X,4 


1784 


• 






PZE ANY ANY 


1785 


• 






NSI 


1786 


• 








1787 



«*•••«*•••**•***«*••••»• 

* LOCATE » 
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* CASES 


WHERE ONE T$X X,0 FOUND 






1788 


• 


TSX 


A, 


B 


1789 


* 


TSX 


X, 


0 


1790 


• 


TSX A,B TSX A 9 B TSX A,B NTR 






1791 


» 0,4 


TSX X,0 TSX X,0 TSX X,0 PZE 






1792 


• 1,4 


NSI NTR TSX Y,4 TSX 


Y, 


4 


1793 


• 


PZE ANY ANY 






1794 


« 


NSI 






1795 


« 








1796 


SKIP SXA 


SV2S,2 






1797 


SXA 


SVl$,l 






1798 


TXI 


•♦1,4,-1 






1799 


SXO 


TXLSKP, 4 






1800 


TXI 


♦+1,4,1 






1801 


AXT 


0,2 XR2 WILL COUNT NO. INSTRUCS^TSX X,0 


1802 


• FIRST CHECK 


FOR TSX X,0 






1803 


CALS CAL 


1,4 






1804 


TSX 


CKTSXZ,! 






1805 


TRA 


NOTSX 






1806 


* IF SO, INDEX, TSX X,0 COUNTER A NO CONTINUE SCAN 






1807 


TXI 


•+1,2,1 






1808 


» GO BACK 








1809 


BACKS TXI 


CALS, 4,-1 






1810 


* IF NOT TSX 


X,0 CHECK FOR NTR X,0,Y 






1811 


* GO BACK IF 


IT IS, BUT DONT INDEX COUNTER 






1812 


NOTSX ANA 


MSK2 KNOCK OUT DECREMENT ALSO 




1813 


LAS 


NTR 






1814 


TRA 


ELSE 






1815 


TXI 


BACKS, 4,-1 






1816 


» CHECK FOR TSX X,4 WHEN ALL OTHER POSSIBLITIES FAIL 






1817 


ELSE CAL 


1,4 (WE LOST THE DECREMENT) 






1818 


TSX 


CKTSX4,1 






1819 


TRA 


T4 (YES) 






1820 


• FOR NON-SPECIAL INSTRUCTION BACK UP TILL 0,4=ANY KINO 


OF TSX 


1821 


* (FIRST SET 


MQ NEGATIVE) 






1822 


LOQ 


MSK1 






1823 


BACK1 CAL 


0,4 






1824 


TSX 


CKTSXA,1 






1825 


TRA 


♦♦2 






1826 


TRA 


EXITS GOT IT 






1827 


TXLSKP TXL 


•+2,4,»* •»=ORIG XR4-1 






1828 


TRA 


EXITS 






1829 


TXI 


BACK1,4,1 






1830 


• SET MQ POSITIVE FOR TSX X,4 AND EXIT 






1831 


T4 LDQ 


Kl 






1832 


* SET AC=NO. 


TSX X,0 INSTRUCTIONS AND RETURN 






1833 


EXITS PXA 


0,2 






1834 


SV1S AXT 


••,1 






1835 


SV2S AXT 


•*,2 






1836 


TRA 


1,1 






1837 


• 








1838 


• 








1839 


* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX INTERNAL 


SUBROUTINE ADJUST 


1840 


• 








1841 


* 








1842 


• LEFT ADJUST 


THE CONTENTS OF MQ AS HOLLERITH 






1843 


« LINKAGE XR1 






1844 


« RESULT 


IN HQ (=606060606060 IF ALL SPACES) 






1845 


• AC LEFT^O 






1846 


« 








1847 


ADJUST SXA 


ALEVE, 2 






1848 


AXT 


0,2 XR2 COUNTS NO* SPACES 






1849 


* CHECK SPACE 








1850 


CLAA CLA 


KO 






1851 


LGL 


6 






1852 


CAS 


K48 






1853 


TRA 


•♦2 






1854 


TRA 


SPAFND 






1855 


« BACK PEDAL 


1 AND LEAVE IF NOT SPACE 






1856 


LGR 


6 






1857 


• LEAVE 








1858 


ALEVE AXT 


•*,2 






1859 


TRA 


1,1 






1860 


* INSERT A SPACE IN MQ AND CHECK FOR 6 






1861 


SPAFND TXI 


♦♦1,2,1 






1862 
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STQ TEMP 1863 

CAL TEMP 1864 

ACL K48 1865 

LGR 36 1866 

TXL CLAA,2,4 1867 

TRA ALEVE 1868 

* 1869 
» 1870 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX INTERNAL SUBROUTINE CNVTAC 1871 

* 1872 
« FORMS TSX A(ARG),0 IN AC (FOR CALL2 ONLY) 1873 

* LINKAGE WITH XR4 (RETURN TO 1,4) 1874 
« 1875 
CNVTAC ARS 18 1876 

ANA MSK3 1877 

SSM 1878 

ADD KC0MP1 1879 

ADD TSX 1880 

TRA 1,4 1881 

* 1882 

* 1883 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX INTERNAL SUBROUTINE FNDXRS 1884 

* 1885 

* FNDXRS FINDS FIRST SXD X,Y IN FRONT OF 0,4, AND THEN 1886 
» LEAVES CONTENTS OF X IN AC 1887 

* Y IS CONTROLLED BY XR2 (I IMPLIES 1),(2 IMPLIES 2), 1888 

* (3 IMPLIES 4) 1889 
» LINKAGE WITH XR1 1890 

* XR4 IS LEFT UNDISTURBED 1891 
« XR2 IS LEFT INCREMENTED BY 1 1892 

* 1893 
FNOXRS SXA SV4FXR,4 1894 
CALFXR CAL -1,4 POSSIBLE SXD X,Y 1895 

STA CLAFXR 1896 

ANA MSK1 1897 

LAS SXDl+1,2 1898 

TRA »+2 1899 

TXI CLAFXR, 2,1 1900 

TXI CALFXR, 4,1 1901 

CLAFXR CLA »» »»*X 1902 

SV4FXR AXT **,4 1903 

TRA 1,1 1904 

* 1905 
» 1906 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX INTERNAL SUBROUTINE GETSXZ 1907 

* 1908 
« GETSXZ SETS TEMP (ADDRESS) 1909 

* = ADDRESS PORTION OF C ( LOCALL+NUMARG) 1910 

* SETS AC (ADDRESS) » DITTO-IXVECT+1 1911 

* LINKAGE WITH XR1 1912 
« ASSUMES AC = LOCALL, MQ * NUMARG, 77775 * IXVECT 1913 

* 1914 
GETSXZ STQ TEMP 1915 

ADD TEMP 1916 

ARS 18 1917 

STA »+l 1918 

CAL «» »»=A(TSX X,0) 1919 

ANA MSK3 1920 

STO TEMP 1921 

ALS 18 1922 

SUB 32765 1923 

ADD KD1 1924 

ARS 18 1925 

TRA 1,1 1926 

» 1927 

* 1928 
» XXXXXXXXXXXXXXXXXXXXXXXXXX INTERNAL SUBROUTINES CKTSX4, CKTSXA, CKTSXZ 1929 
« 1930 
« CHECK LOGICAL WORD IN AC, RETURNING AS FOLLOWS 1931 

* CKTSX4- 1,1 IF AC = TSX X,4 , 2,1 IF NOT 1932 
« CKTSXA- 2,1 IF AC * TSX X, ANYTHING , 1,1 IF NOT 1933 

* CKTSXZ- 2,1 IF AC = TSX X,0 , 1,1 IF NOT 1934 
» 1935 
CKTSX4 ANA MSK1 KNOCK OUT ADDRESS 1936 

LAS TSX4 1937 
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TRA 2 t l 1938 

TRA 1,1 1939 

TRA 2.1 1940 

CKTSXA ANA MSK4 KNOCK OUT AODRESS AND TAG 1941 

TRA *+2 1942 

CKTSXZ ANA MSK1 1943 

LAS TSX 1944 

TRA 1,1 1945 

TRA 2,1 1946 

TRA 1,1 1947 

* 1948 
« 1949 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX TABLE OF CONSTANTS 1950 

* 1951 

* 1952 
KTABLE PZE 14 USED ONLY BY LOCATE TO DIMENSION KEY TABLE 1953 

KO PZE 0 1954 

Kl PZE I 1955 

K2 PZE 2 1956 

K3 PZE 3 1957 

K4 PZE 4 1958 

K48 PZE 48 (* 1 SPACE IN BITS 30-35) 1959 

KD1 PZE 0,0,1 1960 

KD2 PZE 0,0,2 1961 

KD3 PZE 0,0,3 1962 

K04 PZE 0,0,4 1963 

KD5 PZE 0,0,5 1964 

KD6 PZE 0,0,6 1965 

KC0MP1 OCT 000000077462 - ADDRESS OF COMMON BLOCK PLUS 1 1966 

KS2LX0 OCT 010000000000 1967 

MSK1 OCT 777777700000 1968 

MSK2 OCT 700000700000 1969 

MSK3 OCT 000000077777 1970 

MSK4 OCT 777777000000 1971 

FENCE OCT 777777777777 1972 

TSX TSX 0,0 1973 

TSX4 TSX 0,4 1974 

SXD 0,4 1975 

SXD 0,2 1976 

SXD1 SXD 0,1 1977 

NTR OCT 100000000000 1978 

TRAZ TRA 0,0,0 1979 

TTR TTR 0 1980 

* 1981 

* 1982 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX TABLE OF VARIABLES 1983 

* 1984 

* 1985 
BSS 12 (ETC UPWAROS) 1986 
PZE •* »*=XR4 FROM SECOND CALL LOCATE 1987 

KEYS PZE *• **=XR4 FROM FIRST CALL LOCATE (AND 15TH) 1988 

NKEYS PZE 0 **=N0« KEYS PRESENTLY IN TABLE 1989 

NXKEY PZE I **=IND£X OF NEXT KEY TO BE INSERTED IN TABLE 1990 

KOVER PZE 0 ***0(N0RMAL),*1(M0RE THAN 14 CALL LOCATES) 1991 

IXKEY PZE *• **=INDEX OF KEY ABOUT TO BE USED 1992 

TRA TRA ** 1993 

SUBROU PZE *» »*=6HSUBR0U 1994 

LOC PZE 0,0,** 1995 

TEMP PZE ** 1996 

TEMP 2 PZE ** 1997 

TEMP3 PZE 0,0,** 1998 

TEMP4 PZE ** 1999 

TEMP5 PZE ** 2000 

ICALL PZE ** 2001 

* 2002 

* 2003 

* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX END 2004 

* 2005 

* 2006 
END 2007 
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♦LSHFT 



LSHFT {FUNCTION) 
FAP 

COUNT 100 
LBL LSHFT 
ENTRY LSHFT (N,X) 
ENTRY XLSHFT <N,X) 



9/29/64 



LAST CARD IN DECK IS NO. 



-ABSTRACT— 



* TITLE - LSHFT 

« LOGICAL SHIFT FUNCTION 



* LANGUAGE 
» EQUIPMENT 
» STORAGE 

» SPEEO 

* AUTHOR 



LSHFT PERFORMS A LOGICAL RIGHT OR LEFT SHIFT OF A WORD. 
XLSHFT PERFORMS THE SAME OPERATION. 

- FAP FUNCTION (FORTRAN II COMPATIBLE! 

- 709 OR 7090 (MAIN FRAME ONLY) 

- 12 REGISTERS 

- ABOUT 25 MACHINE CYCLES. 

- R.A. WIGGINS JULY, 1963 

-—USAGE 



» TRANSFER VECTOR CONTAINS ROUTINES - NONE 
» AND FORTRAN SYSTEM ROUTINES - NONE 

* 

* FORTRAN USAGE 

» XI = LSHFTF < Nt X ) 

* II = XLSHFTF (NtX) 



INPUTS 



OUTPUTS 
XI 
II 

EXAMPLES 



IS THE NUMBER OF PLACES TO BE SHIFTEO. 
IF GRTHN 0 SHIFTING IS TO THE RIGHT. 
IF LSTHN 0 SHIFTING IS TO THE LEFT. 
MUST BE GRTHN* -35, LSTHN* 35 

IS WORD TO BE SHIFTED. 

NEED NOT HAVE FLOATING POINT NAME. 



IS THE SHIFTED WORD 



IS SAME AS XI. 



1. 



INPUTS 
OUTPUTS 



N=6 
XI* 



X * OCT 774200011201 
OCT 007742000112 



2. INPUTS 
OUTPUTS 



N=~6 X * OCT 774200011201 
XI* OCT 420001120100 



• PROGRAM FOLLOWS BELOW 



0071 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 



* 






0057 


XLSHFT 


BSS 


0 


0058 


LSHFT 


ARS 


18 


0059 




STA 


SFTR 


0060 




STA 


SFTL 


0061 




CLM 




0062 




TPL 


SFTR 


0063 


SFTL 


LGL 


*» 


0064 




TRA 


•♦2 


0065 


SFTR 


LGR 


«* 


0066 




LLS 


0 


0067 




LGL 


36 


0068 




TOV 


•♦1 


0069 




TRA 


lt4 


0070 




END 




0071 
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• LSLINE » * LSLINE * 

• ••••**«••»*•***••••#*#« 4 • »»»•*»*•#«* 



* LSLINE (SUBROUTINE) 10/1/64 LAST CARO IN DECK IS NO, 0081 

* LABEL 0001 
CLSLINE 0002 

SUBROUTINE LSLINE (YY,LY,XMIN,XMAX,C0,C1 ) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - LSLINE 0007 

C LEAST-SQUARE LINE 0008 

C 0009 

C LSLINE FITS A LINE TO AN EQUALLY SPACED INPUT SERIES BY 0010 

C LEAST-SQUARES* THAT IS, GIVEN AN EQUALLY SPACE© DATA 0011 

C SERIES Y(XMIN)...Y(XMAX), LSLINE FINDS THE COEFflClENTS 0012 

C CO AND CI SO THAT 0013 

C 2 2 0014 

C IY(XMIN)-C0-C1«XMIN) ♦ ♦ < Y( XMAX )-CO-Cl#XMAXl 0015 

C 0016 

C IS A MINIMUM, 0017 

C 0018 

C LANGUAGE -* FORTRAN II SUBROUTINE 0019 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0020 

C STORAGE - 117 REGISTERS 0021 

C SPEED - ABOUT 380 MACHINE CYCLES ON 709 (LESS ON 7090) 0022 

C AUTHOR - R. A. WIGGINS 0023 

C 0024 

C -—USAGE 0025 

C 0026 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0027 

C AND FORTRAN SYSTEM ROUTINES - NONE 0028 

C 0029 

C FORTRAN USAGE 0030 

C CALL LSLINE(YY t tY,XMIN,XMAX,CO,Cl) 0031 

C 0032 

C INPUTS 0033 

C 0034 

C YY(I) I=1.*.LY CONTAINS THE DATA POINTS Y( XMIN) • «. Y( XMAX) FOR 0035 

C AN EQUALLY SPACEO SERIES • 0036 

C 0037 

C LY MUST EXCEED ONE. 0038 

C 0039 

C XMIN IS THE X COORDINATE CORRESPONDING TO YYC1), 0040 

C 0041 

C XMAX IS THE X COORDINATE CORRESPONDING TO YYCLYJ. 0042 

C 0043 

C OUTPUTS 0044 

C 0045 
C CO IS THE FIRST COEFFICIENT FOR THE BEST LEAST-SQUARE LINE* 0046 

C 0047 

C CI IS THE SECOND COEFFICIENT. 0048 

C THUS* THE LINE IS GIVEN BY CO + C1*X. 0049 

C 0050 

C EXAMPLES 0051 

C 0052 

C 1- INPUTS — LY = 5 YYU...5) = 2., 3. ,4. * 5. ,6. 0053 

C XMIN » 2. XMAX * 6. 0054 

C OUTPUTS - CO = 0. CI = 1. 0055 

C 0056 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT XMIN * 0. XMAX * 4. 0057 

C OUTPUTS - CO * 2* CI = 1. 0058 

C 0059 

C 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT XMIN * -1. XMAX * 7. 0060 

C OUTPUTS - CO * 2.5 CI = .5 0061 

C 0062 

DIMENSION YY(10) 0063 

XLY=LY 0064 

DELX * (XMAX-XMIN)Z(XLY-l.) 0065 

X=XMIN-DELX 0066 

SMX=0. 0067 

SMXX-O. 0068 

SMY=0. 0069 

SMXY*0. 0070 

DO 10 I=1,LY 0071 

X*X+DELX 0072 

SMX=SMX+X 0073 

SMY=SMY+YY(I) 0074 
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SMXX=S^XX+X*X 0075 

10 SMXY=SMXY+X*YY(I) 0076 

DEN = XLY*SWXX-SMX*SMX 0077 

CO = (SMY*SMXX-S^XY«SMX)/DEN 0078 

CI = (XLY*SMXY-SMX*SMY)/DEN 0079 

RETURN 0080 

END 0081 
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* LSSSl C SUBROUT INE ) 9/29/64 LAST CARD IN DECK IS NO. 0115 

* LABEL 0001 
CLSSS1 0002 

SUBROUTINE LSSSl < LL , AA,RR, GG,FF, ALP ) 0003 

C 0004 

C -ABSTRACT 0005 

C 0006 

C TITLE - LSSSl 0007 

C LEAST SQUARE SHAPER BY SIDEWAYS ITERATION 0008 

C 0009 

C LSSSl PERFORMS A SIDEWARDS ITERATION OF A SHAPER FILTER 0010 

C F<K,L> (K REFERS TO THE K-TH ELEMENT IN A VECTOR OF 0011 

C LENGTH L) TO CORRESPOND TO A SIMILAR ITERATION OF A 0012 

C CROSSCORRELATION VECTOR G(K )• THAT IS, GIVEN A VECTOR 0013 

C F«K!L) THAT SATISFIES THE EQUATIONS 0014 

C 0015 

C F(Lt LMR(O) + ... + FI1,L)»R<L-1> » GIL-1) 0016 

C 0017 

C F(L,L**RU> ♦ ... + FU,L)*R(L-2) * GU-2) 0018 

C . 0019 

C . 0020 

C F<L,LJ*R(-L+1>+. ... ♦ FU,L)*R<0) * G«0> 0021 

C 0022 

C AND ACK#L-1) AND ALP<0,L-1) THAT CORRESPOND TO RCT) ftAS 0023 

C GIVEN BY RLSPR) THEN LSSSl COMPUTES THE VECTOR F1CK,L) 0024 

C WHICH SATISFIES 0025 

C 0026 

C F1(L»L)*R(0) + ... + Fm,L)*RU~l) * GlL-2* 0027 

C . 0028 

C . 0029 

C . 0030 

C F1(L,L)«R{-L+1>+ ... + F1C1,L)»R<0) = Gt»-l) 0031 

C 0032 

C SEE SUBROUTINE RLSSR FOR AN INTERPRETATION OF RiK? AND 0033 

C G<K>. 0034 

C 0035 

C LANGUAGE - FORTRAN II SUBROUTINE 0036 

C EQUIPMENT - 709 OR 7090 { MAIN FRAME ONLY) 0037 

C STORAGE - 122 REGISTERS 0038 

C SPEED - ABOUT .000210«L ♦ .00019 SECONDS ON THE 7094 MOD 1 . 0039 

C AUTHOR - R. A. WIGGINS 3/63 0040 

C 0041 

C — — USAGE 0042 

C 0043 

C TRANSFER VECTOR CONTAINS ROUTINE - FOOT 0044 

C AND FORTRAN SYSTEM ROUTINE - NONE 0045 

C 0046 

C FORTRAN USAGE 0047 

C CALL LSSSl ( LL t AA» RRf GGtFFt ALP ) 0048 

C 0049 

C INPUTS 0050 

C 0051 

C LL =L IS THE LENGTH OF A, R f AND F VECTORS. 0052 

C MUST BE GRTHN-2 0053 

C 0054 

C AA( I ) 1=1, ..*,LL CONTAINS THE PREDICTION ERROR OPERATOR 0055 

C A(0,L-1) THROUGH AU-l f L-l). 0056 

C 0057 

C RRII) I=1»..*,LL CONTAINS THE AUTOCORRELATION VECTOR RtOI 0058 

C THROUGH R(L-l). 0059 

C 0060 

C GGf I ) I=1,...,LL+1 CONTAINS THE CROSSCORRELATION VECTOR Gf-1) 0061 

C THROLGH G(L-l). 0062 

C 0063 

C FFU) 1*1, *..,LL CONTAINS THE SHAPER FILTER FUtL) THROUGH 0064 

C F(L,L). 0065 

C 0066 

C ALP CONTAINS THE ERROR COVARIANCE ALP(0,L-1) 0067 

C 0068 

C OUTPUTS 0069 

C 0070 

C FFU) 1 = 1,. ..,LL CONTAINS THE SHAPER FILTER FlCl#L) THROUGH 0071 

C FULfL). 0072 

C 0073 



•»•••»•*•**«*********•#« PROGRAM LISTINGS #*•#*•*•••#*•#•••**»**•* 

# LSSS1 * # LSSS1 * 

•••*•*•«•*••••«•••*••»*• *»««**•••*•••*»•«•*#**#* 

( PAGE 2) (PAGE 2) 

C EXAMPLES 0074 

C 0075 

C 1. INPUTS - LL=0 RR< 1)=1.25,.5 GGf 1...2 )=0. f 1. 0076 

C USAGE - DIMENSION FF<2) 0077 

C DC 10 1=1,2 0078 

C CALL RLSPR ( LL , AA, RR, ALP ) 0079 

C 10 CALL RLSSR ( LL, AA, RR* GG( 2 > , FF, ALP ) 0080 

C CALL LSSSKLL, AA,RR,GG< 1),FF,ALP) 0081 

C OUTPUTS - LL = 2 FF<U..2) = -0.381,0.9524 0082 

C 0083 

C 2. INPUTS - LL = 0 RR< 1. . .5 )= I. 25 , . 5, 0. , 0. , 0. 0084 

C GG(1*..9)=0.,0.,0.,0.,1.,0.,0.,0.,0. 0085 

C USAGE - DO 10 1=1,5 0086 

C CALL RLSPR ( LL, AA, RR, ALP ) 0087 

C CALL RLSSR < LL , AA, RR , GG( 5) , FF, ALP > 0088 

C 10 CONTINUE 0089 

C DO 20 1=1,4 0090 

C J=5-I 0091 

C CALL LSSSKLL, AA,RR,GG( J), FF, ALP) 0092 

C 20 CONTINUE 0093 

C OUTPUTS - LL*5 AA { I ... 5 ) = 1 .000,-0.498, 0.246,-0. 117, 0. 04T 0094 

C FF(1... 5) =0.0 47, -0.117, 0.2 46,-0. 498, 0.999 0095 

C 0096 

C PROGRAM FOLLOWS BELOW 0097 

C 0098 

DIMENSION AA(10),RR<10),GG<10),FF<10) 0099 

L1=LL 0100 

L2=Li+2 0101 

FL=FF<L1) 0102 

DO 10 1=2, LI 0103 

J=L2-I 0104 

K=J-1 0105 

FF< J)=FF<K)~FL»AA( I ) 0106 

10 CONTINUE 0107 

CALL FD0T(L1-1,FF(2),RR(2),C1) 0108 

F=(GG<1)-C1)/ALP 0109 

FF(1)=F 0110 

DO 20 1=2, LI 0111 

FF(I)=FFU) + F*AAU) 0112 

20 CONTINUE 0113 

RETURN 0114 

END 0115 
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» MATINV (SUBROUTINE) 9/29/64 LAST CARD lit DECK IS NO. 

» LABEL 

CMATINV 

SUBROUTINE MATINV (LA, A, B, SPACE, ERR ) 

C 

C ——ABSTRACT 

C 

C TITLE - MATINV 

C INVERSE OF A MATRIX 

C 

C MATINV FINOS THE INVERSE OF AN N BY N DIMENSIONAL MATRIX. 

C 

C LANGUAGE - FORTRAN II SUBROUTINE 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 

C STORAGE - 90 REGISTERS 

C SPEED - ABOUT 33»N*N*N + 110*N*N + 163*N + 209 MACHINE CYCLES 

C ON THE 7090. 

C AUTHOR - R.A. WIGGINS 2/63 

C 

C -USAGE 

C 

C TRANSFER VECTOR CONTAINS ROUTINES - SIMEQ 
C AND FORTRAN SYSTEM ROUTINES - NONE 

C 

C FORTRAN USAGE 

C CALL MATINV(LA, A, B, SPACE, ERR ) 

C 

C INPUTS 
C 



LA 



A(I) 



IS THE DIMENSION OF ONE SIDE OF THE MATRIX. 
MUST EXCEED ZERO. 

I=1,...LA*LA IS A SQUARE MATRIX STORED CLOSELY PACKED 
BY COLUMNS. I.E. 

AU...LA) CONTAINS COLUMN 1. 

A(LA+1...2»LA) CONTAINS COLUMN 2. 
ETC. 



SPACE(I) 



I=1,*..,LA»(LA+1) 
BY MATINV. 



I=1...LA*LA IS THE INVERSE OF A. 
COLUMNS, CLOSELY PACKED. 



=0. 
= 1. 

= 2. 



IF SOLUTION WAS SUCCESSFUL. 
IF OVERFLOW OCCURRED. 
IF THE MATRIX A WAS SINGULAR. 



C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

C OUTPUTS 
C 

C B(I ) 
C 
C 

C ERR 
C 
C 
C 

C EXAMPLES 
C 

C 1. INPUTS 
C OUTPUTS 

c 

C 2. INPUTS 
C OUTPUTS 
C 

C PROGRAM FOLLOWS BELOW 
C 

C DUMMY DIMENSION OF INPUT VARIABLES. 

DIMENSION AC9),B(9),SPACE(12) 
LAA=LA*LA 
LA1=LA+1 

C 

C MOVE A INTO B, AND CLEAR PART OF SPACE 

DO 10 1=1, LAA 
B(I)»A(I) 
10 SPACE(I)*0. 

C 

C SET UP A UNIT MATRIX IN SPACE. 

DO 20 I=1,LAA,LA1 
20 SPACE(I)=1. 

C 
C 



IS COMPUTATIONAL SPACE NEEDED 



IT IS STORED BY 



- LA = 2 



LA * 2 



A( 1.. 
8(1.. 



.4) 
.4) 



3.00, 
3.67, 



All. ..4) = 3.00, 
BU...4) = 3.67, 



1.20, 2.50, 1.10 

-4.00, -8.33, 10.00 

2.50, 1.20, i.iO 

-8.33, -4.00, 10. CO 



INVERT A 



0078 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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D = l. 

CALL SIMEQ ( LA f L A, LA, B, S PACE, D, SPACE( L AA+ 1 ) , ERR ) 

RETURN 

END 
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0075 
0076 
0077 
0078 



*•••••»•*• »<*»**•* »***»#* 
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*»*«*•**»••*•«••*«****•* 
* MATMH * 
**«•*«•*»**•*«•••*•«**•* 



* MATMLi (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO* 0136 
« FAP 0001 
•MATMLI 0002 

COUNT 10G 0003 

LBL MATMLI 0004 

ENTRY MATMLI (LA,A,B,C,M) 0005 

» 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - MATML1 0009 
» SQUARE MATRIX MULTIPLICATION 0010 

* 0011 

* MATML1 MULTIPLIES TWO SQUARE MATRICES* A AND B, TO 08TAIN 0012 
» THE PRODUCT C. 0013 

* 0014 
» C = A * B 0015 

* 0016 

* A, B AND C ARE ASSUMED TO BE CLOSELY PACKED BY COLUMNS* 0017 

* 0018 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0019 

* EQUIPMENT - IBM 709 OR 7090 (MAIN FRAME ONLY) 0020 

* STORAGE - 61 REGISTERS 0021 

* SPEED - IF ZIFSTO=i. ABOUT 18*N»N«N ♦ 9»N*N + 10»N + 66 0022 

* MACHINE CYCLES, 0023 

* IF ZIFST0=0. ABOUT 18*N*N*N * 12*N*N ♦ 10»N ♦ 66 0024 
» MACHINE CYCLES ON THE 7090, 0025 

* WHERE Z1FST0=0. IF THE PRODUCT IS STORED IN THE OUTPUT 0026 

* AREA AND =1. IF THE PRODUCT IS ADDED TO THE OUTPUT 0027 

* AREA. 0028 

* AUTHOR - R.A. WIGGINS 2/63 0029 
« 0030 

* ——USAGE 0031 

* 0032 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0033 

* AND FORTRAN SYSTEM ROUTINES - NONE 0034 

* 0035 

* FORTRAN USAGE 0036 

* CALL MATMLKLA, A,B,C,M) 0037 

* 0038 

* INPUTS 0039 
» 0040 
» LA IS THE LENGTH OF THE COLUMNS (OR ROWS) OF A, B* AND C* 0041 

* IS FORTRAN INTEGER 0042 

* MUST BE GRTHN^l. 0043 

* 0044 
» A(I) I=1...LA«LA IS A SQUARE MATRIX STORED BY COLUMNS, 0045 

* I.E. AU...LA) CONTAINS COLUMN 1. 0046 

* A(LA+1...2«LA) CONTAINS COLUMN 2. 0047 

* ETC. 0048 

* 0049 
« B(I) I=i.*.LA*LA IS A SQUARE MATRIX STORED BY COLUMNS. 0050 

* SEE ABOVE 0051 
» 0052 
» M =0 THE CONTENTS OF C ARE SET TO ZERO BEFORE 0053 

* MULTIPLICATION. 0054 

* NOT =0 THE MULTIPLICATION IS ADDED TO THE PREVIOUS 0055 

* CONTENTS OF C. 0056 
« 0057 

* OUTPUTS 0058 

* 0059 

* C(I) I==1...LA*LA IS THE SQUARE MATRIX (STORED BY COLUMNS) 0060 
« THAT IS THE PRODUCT OF A AND B. 0061 
» 0062 

* EXAMPLES 0063 

* 0064 

* 1. INPUTS ~ LA*2 A(l.. .4) = i.,1.,2.,1. B(U..4) = 2.,!., 3. ,4. 0065 

* M » 0 0066 

* 0067 
« OUTPUTS - C(l.*.4) = 4. t 3.,ll.,7. 0068 

* 0069 

* 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT M=l CU...4) * l.,l.»l.,l. 0070 

* 0071 
» OUTPUTS - C(l...4) = 5. ,4., 12. ,8. 0072 

* 0073 
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» PROGRAM FOLLOWS BELOW 





HTR 


0 




BCI 


ltMATMLl 


MATML1 


SXD 


*-2 ,4 




SXA 


EX, 1 




SXA 


EX+1,2 




CAL 


2,4 




ADO 


= 1 




STA 


A 




CAL 


3,4 




ADD 


=i 




STA 


B 




CAL 


4,4 




ADD 


= 1 




STA 


C 




STA 


C+l 




STA 


CI 




CLA* 


1,4 




STO 


LA 




STD 


TIO 




XCA 






MPY 


LA 




ALS 


17 




STO 


LAA 




STO 


LAA1 




STO 


LAA2 




CLA» 


5,4 




TNZ 


Tl 




LXD 


LAA, 4 


C 1 


STZ 


»* ,4 




TIX 


Ci ,4,1 


Tl 


LXD 


LAA , 1 




LXD 


LAA, 2 




LXD 


LAA, 4 


A 


LDQ 


**, 1 


B 


FMP 


** ,2 


C 


FAD 


»* ,4 




STO 


«» ,4 


TIO 


TIX 


T30, 1 , ♦« 




TIX 


T15,i,l 




LXD 


LAA, 1 




SXD 


LAA1 , 1 




TIX 


T13,2,l 


EX 


AXT 


*♦» 1 




AXT 


«*,2 




LXD 


MATMLl-2,4 




TRA 


6,4 


T13 


SXD 


LAA2,2 




TRA 


T20 


T15 


LXD 


LAA1, 1 




TIX 


•+ltl»l 




SXD 


LAA1,1 




LXD 


LAA2,2 


T20 


TIX 


A, 4,1 




TRA 


EX 


T30 


TIX 


A, 2,1 




TRA 


EX 


LA 


PZE 




LAA 


PZE 




LAA1 


PZE 




LAA2 


PZE 
END 
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0074 




0075 




0076 




0077 


SAVE 


0078 


INDEX 


0079 


REGISTERS* 


0080 


GET 


0081 


ADDRESS 


0082 


OF A. 


0083 


GET 


0084 


ADDRESS 


0085 


OF B. 


0086 


GET 


0087 


ADDRESS 


0088 


OF 


0089 


C. 


0090 




0091 


GET 


0092 


LA 


0093 


AND SAVE. 


0094 


DETERMINE 


0095 




0096 


LA«L A 


0097 




0098 




0099 




0100 


DETERMINE 


0101 


MODE OF M. 


0102 


SET 


0103 


C = 0. 


0104 




0105 


LOAD 


0106 


INDEX 


0107 


REGISTERS. 


0108 


CENTRAL 


0109 


LOOP. 


0110 




0111 




0112 


A 


01 13 


INDEXED 


0114 


BY 


0115 


ROWS. 


0116 




0117 


EXIT 


0118 




0119 




0120 




0121 


B INDEXED 


0122 


BY COLUMNS. 


0123 




0124 




0125 




0126 




0127 




0128 




0129 




0130 




0131 




0132 




0133 




0134 




0135 




0136 



•****•****•*»•••••»•**#* 

» MATML3 * 
***»*•**•*•***•**••*•««• 



PROGRAM LISTINGS 



*««**«•*•*•* •«*****•«•** 
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* MATML3 (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0104 

» LABEL 0001 

CMATML3 0002 
SUBROUTINE MATML3 ( N , M t L » A A , B8 f TRAN T CC » M 1 ) 0003 

C 0004 

C — — ABSTRACT 0005 

C 0006 

C TITLE - MATML3 0007 

C N X M MATRIX BY M X L MATRIX MULTIPLICATION 0008 

C 0009 

C MATML3 MULTIPLIES AN N X M MATRIX A BY AN M X L MATRIX B 0010 

C TO OBTAIN AN N X L PROOUCT MATRIX C. 0011 

C 0012 

C ML L 0013 

C ( ) i ) i ) 0014 

C N ( A ) * ( ) = N (C) 0015 

C ( ) (B) M { ) 0016 

C ( ) 0017 

C ( ) 0018 

C 0019 

C A IS ASSUMMED TO BE STORED BY COLUMNS. B MAY BE STORED 0020 

C BY COLUMNS OR ROWS. 0021 

C 0022 

C LANGUAGE - FORTRAN II SUBROUTINE 0023 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0024 

C STORAGE - 120 REGISTERS 0025 

C SPEED - ABOUT U18*M + 98)*N ♦ 14)»L + 108 MACHINE CYCLES ON 0026 

C THE 7090. 0027 

C AUTHOR - R.A. WIGGINS 3/63 0028 

C 0029 

C USAGE 0030 

C 0031 

C TRANSFER VECTOR CONTAINS ROUTINES - DOTJ 0032 

C AND FORTRAN SYSTEM ROUTINES - NONE 0033 

C 0034 

C FORTRAN USAGE 0035 

C CALL PATML3CN, MrfLt AA, BB, TRAN,CC, Ml ) 0036 

C 0037 

C INPUTS 0038 

C 0039 

C N IS THE NUMBER OF ROWS IN A. 0040 

C MUST BE GRTHN=1 0041 

C 0042 

CM IS NUMBER OF COLUMNS IN A. 0043 

C IS NUMBER OF ROWS IN B ( AFTER TRANSPOSITION) 0044 

C MUST BE GRTHN-l 0045 

C 0046 

C L IS NUMBER OF ROWS IN B (AFTER TRANSPOSITION) 0047 

C MUST BE GRTHN= 1 0048 

C 0049 

C AAU) I=i,*..,N*M CONTAINS THE MATRIX A STORED BY COLUMNS. 0050 

C THAT IS 0051 

C AAU...N) CONTAINS COLUMN 1 OF A. 0052 

C AA(N*1...2*N) CONTAINS COLUMN 2 OF A. 0053 

C ETC. 0054 

C 0055 

C BBII) I»1 9 »«J,M*L CONTAINS THE MATRIX B STORED BY EITHER ROWS 0056 

C OR COLUMNS. 0057 

C 0058 

C TRAN IF NOT = 0. BB IS TRANSPOSED BEFORE MULTIPLICATION* 0059 

C IF = 0. THE MULTIPLICATION IS MADE WITH BB AS STORED. 0060 

C 0061 

C Ml IF GRTHN 0 THE PRODUCT C IS ADDED TO THE- VALUE OF C 0062 

C ON INPUT. 0063 

C IF LSTHN-0 C IS CLEARED BEFORE MULTIPLICATION. 0064 

C 0065 

C OUTPUTS 0066 

C 0067 

C CC(I) I=1,...,N*L CONTAINS THE MATRIX C STORED BY COLUMNS. 0068 

C 0069 

C EXAMPLES 0070 

C 0071 

C I. INPUTS - N=l M=l L=L AAU) = 2. BBC1>»3. M1=0 TRAN«0. 0072 

C OUTPUTS - CC(1)=6. 0073 

C 0074 
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C 2. INPUTS - N=3 M=2 L=2 AAU...6) = 1. , 1. , 3. , 2. ,7. , 1. 0075 

C TRAN=0. 8BU...4) = U,5.,3.f7. 0076 

C CC(1...6) « 6.,0.,0., O.iO.t 0. Ml*l 0077 

C OUTPUTS - CCtl,. .6) = 17,, 36. ,8., 17. ,52. ,16. 0078 

C 0079 

C 3. INPUTS - SAME AS EXAMPLE 2. EXCEPT TRAN * 1. Mi * 0 0080 

C OUTPUTS - CCCl..«i6) = 7. , 22. , 6. , 19. , 54. , 22. 0081 

C 0082 

C PROGRAM FOLLOWS BELOW 0083 

C 0084 

DIMENSION AA(10),BB(10),CC(10) 0085 

J3=0 0086 

LI=L 0087 

IF (TRAN) 5*6,5 0088 

5 Ll^LI 0089 
L2=l 0090 
L3=LI 0091 
GO TO 7 0092 

6 L1*LI*M 0093 
L2=M 0094 
L3=l 0095 

7 DO 20 I=1,L1,L2 0096 
J2=l 0097 
DO 10 J=1,N 0098 
J3=J3+1 0099 
CALL DOTJ(M,N,AA( J),L3,BB(I),CC(J3),M1,U) 0100 

10 CONTINUE 0101 

20 CONTINUE 0102 

RETURN 0103 

END 0104 
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* MATRA (SUBROUTINE) 9/29/64 LAST CARD IN ©ICK IS NO. 0176 

* FAP 0001 
♦MATRA 0002 

COUNT 100 0003 

LBL MATRA 0004 

ENTRY MATRA IA* N, M, ATRAN ) 0005 

* 0006 
« ABSTRACT — — 0007 

* 0008 
» TITLE - MATRA 0009 

* MATRIX TRANSPOSE 0010 
» 0011 

* MATRA FINDS THE MATRIX TRANSPOSE OF A MATRIX WHICH HAS 0012 

* ITS ROWS CLOSELY PACKED. EQUIVALENCE OF INPUT AND OUTPUT 0013 

* AREAS IS ALLOWED. DURING THE PROCESS OF TRANSPOSITION, 0014 
» THE LOW ORDER BIT (BIT 36) OF THE OATA WORDS IS SET TO 0015 

* ZERO. 0016 
» 0017 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0018 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0019 
« STORAGE - 92 REGISTERS 0020 

* SPEED - ABOUT (.000080 +0R- .000010)*N*M ♦ .000200 SiCONOS 0021 
» ON THE 7094 MOD 1 WHERE N»M IS THE TOTAL NUMBER OF 0022 

* ELEMENTS. 0023 

* AUTHOR - R.A. WIGGINS AND S.M. SIMPSON, 3/63 0024 

* 0025 
» + USAGE 0026 

* 0027 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0028 

* AND FORTRAN SYSTEM ROUTINES - NONE 0029 

* 0030 

* FORTRAN USAGE 0031 

* CALL MATRA ( A, N,'M, ATRAN) 0032 
» 0033 

* INPUTS 0034 
» 0035 

* A(I) I = l,..i,N»M IS THE N X M MATRIX TO BE TRAHSPOSED.- THE 0036 
» MATRIX IS ASSUMED TO BE STORED CLOSELY PACKED BY 0037 

* COLUMNS. 0038 

* 0039 

* N IS NUMBER OF ROWS IN THE INPUT MATRIX. 0040 

* IS NUMBER OF COLUMNS IN THE OUTPUT MATRIX. 0041 

* MUST BE GRTHN- 1 0042 

* 0043 

* M IS NUMBER OF COLUMNS IN THE INPUT MATRIX. 0044 
» IS NUMBER OF ROWS IN THE OUTPUT MATRIX. 0045 
» MUST BE GRTHN=1 0046 

* 0047 

* OUTPUTS 0048 

* 0049 
» ATRAN ( I ) I=i,...,M«N IS THE M X N TRANSPOSED MATRIX STORED 0050 

* CLOSELY PACKED BY COLUMNS. THE LOW ORDER BIT 0051 

* HAS BEEN SET TO ZERO. 0052 

* MAY BE EQUIVALENT TO A(I). 0053 

* 0054 
» EXAMPLES 0055 

* 0056 

* 1. INPUTS - N=5 M*2 A( 1. . . 10 )* 1. , 2. , 3. , 4., 5. , 6. , 7. r 8# ,9. 4 10. 0057 

* OUTPUTS - ATRAN(l..*10)~l.,6.f2.,7.,3.,8.,4*,9*»5.ifl0. 0058 

* 0059 
« 2. INPUTS ~ N=l M=4 A( 1 . . .4)= 1* , 2. , 3., 4. 0060 

* OUTPUTS - ATRAN ( l«..4) s l.,2.,3.,4. 0061 

* 0062 
» 3. INPUTS - N=l M=*l Ad) = 2. 0063 

* OUTPUTS - ATRAN(l) = 2. 0064 

* 0065 

* PROGRAM FOLLOWS BELOW 0066 
» 0067 

HTR 0 0068 

HTR, 0 0069 

HTR* 0 0070 

BCI 1, MATRA 0071 

MATRA SXD MATRA-4 , 1 0072 

SXD MATRA-3 ,2 0073 

SXD MATRA-2 ,4 0074 
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» GET 


ADORESSES OF A AND ATRAN 


0075 




CAL 


1,4 




0076 




ADO 


= 1 B35 




0077 




STA 


A 




0078 




CAL 


4,4 




0079 




STA 


ATI 




0080 




STA 


AT2 




0081 




STA 


AT3 




0082 




ADD 


= 1835 




0083 




STA 


AT 




0084 


* GET 


N AND M 


AND STORE 


IN NSCALD AND MM. 


0085 




CLA» 


2,4 




0086 




TZE 


EXIT 




0087 




TMI 


EXIT 




0088 




ARS 


18 




0089 




STO 


NSCALD 




0090 




CLA» 


3,4 




0091 




TZE 


EXIT 




0092 




TMI 


EXIT 




0093 




ARS 


18 




0094 




STO 


MM 




0095 




XCA 






0096 




MPY 


NSCALD 




0097 




XCA 






0098 




PAX 


»l 




0099 




TIX 


*+i,l,l 




0100 




SXD 


ENDCCl 




0101 




TXI 


♦♦1,1,1 




0102 


• SET 


VDP, VLM 


, AND ALS 


INSTRUCTIONS, AND NSCALD 


0103 




CAL 


=0777700777777 


0104 




ANS 


VDP 




0105 




ANS 


VLM 




0106 




CLA 


MM 




0107 




ORA 


=0233000000000 


0108 




FAD 


=0233000000000 


0109 




ANA 


=0077000000000 


01 10 




ARS 


9 




0111 




ORS 


VDP 




0112 




ORS 


VLM 




0113 




PDX 


t2 




0114 




SXA 


ALS, 2 




0115 




CLA 


NSCALD 




0116 


ALS 


ALS 


• * 


**=N0. BITS IN ( M) 


0117 




STO 


NSCALD 




0118 


* PUT 


A FLAG 


IN BIT 35 


OF DATA AND MOVE TO OUTPUT AREA. 


0119 


A 


CAL 


***1 


**=ADR(A)+1 


0120 




ORA 


= 1B35 




0121 


AT 


SLW 


**4l 


**=ADR( ATRAN ) + l 


0122 




TIX 


A, 1,1 




0123 


» 








0124 


* TRANSPOSE THE OUTPUT 




0125 


* THE 


GENERAL 


SCHEME IS 


TO MOVE A WORD FROM 11 TO 12 


0126 


• 








0127 


« 


12 = Il/N + XMODFi Il f N)*M 


0128 


* 








0129 


• THEN SET 11 


= 12 AND 


REPEAT. 


0130 


* 








0131 


» WHEN WE LOOP BACK ON 


OURSELF WE SEARCH FOR A NEW BEGINNING fcQINT 


0132 


» UNTIL ALL TERMS ARE TRANSPOSED. 


0133 


» 








0134 


» BEGIN WITH 


11=0 (FOR 


THE LOOP WE LET THE FIRST VALUE HAVE INDEX 0) 


0135 


» 








0136 




AXT 


1,1 


KEEPS TOTAL COUNT 


0137 




AXT 


0,4 


KEEPS PRESENT LOCATION 


0138 


AT3 


CLA 


**,4 


*#-ADR (ATRAN ) 


0139 




L8T 






0140 




TXI 


AT3,4,1 




0141 


NWI 


STO 


TEMP 




0142 




SXD 


ECC ,4 




0143 


» GET 


NEXT INDEX 




0144 


NXTI 


LDQ 


=0 




0145 




PXA 


,4 




0146 


VDP 


VDP 


NSCALD#0 


,«# **=NC. BITS IN (M) 


0147 




STO 


Tl 




0148 




STQ 


T 




0149 
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LOQ 


MM 




0150 


VLM 


VLM 


T1,0,** 


**= NO. BITS IN (M) 


0151 




ADD 


T 




0152 




PAX 


,4 




0153 


» EXCHANGE 


THE NUMBERS 




0154 


ATI 


LDQ 


*#,4 


»»=ADR( ATRAN ) 


0155 




CAL 


TEMP 




0156 




ANA 


=0777777777776 


0157 


AT2 


SLW 


** ,4 


»»ssAOR( ATRAN ) 


0158 




STQ 


TEMP 




0159 




TXI 


•♦itlt 1 




0160 


ECC 


TXH 


NXTI ,4#»* 


**=FIRST LOOP VALUE. 


0161 


* IF NOT ALL VALUES HAVE 


BEEN TRANSPOSED, SEARCH FOR NEXT STARTING POINT 


0162 


ENDCC 


TXH 


EXIT, 


*»=N*M-1 


0163 


SRCH 


TXI 


AT3,4,1 




0164 


EXIT 


LXD 


MATRA-4,1 




0165 




LXD 


MATRA-3 , 2 




0166 




LXD 


MATRA-2 1 4 




0167 




TRA 


5,4 




0168 










0169 


T 


PZE 






0170 


Tl 


PZE 






0171 


TEMP 


PZE 






0172 


MM 


PZE 


• » 


*»=M( IN ADDRESS) 


0173 


NSCALO 


PZE 


• » 


»»=N(IN ADDRESS)«2 EXPINO.BITS IN< Ml ) 


0174 




END 






0175 
0176 
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4»«*ft**» •»**•«• •*••**»** 
# MATRA1 # 
#**«»*••*««**#•*»*•**»•» 



» 


MATRA1 


(SUBROUTINE) 9/29/64 LAST CARD 


IN DECK IS 


NO. 0094 


* 


FAP 








0001 


•MATRA1 








0002 




COUNT 


10X> 






0003 




LBL 


MATRA1 






0004 




ENTRY 


MATRA1 ( L A f A ) 






0005 


* 










0006 


• 




— ABSTRACT — — 






0007 


* 










0008 


* 


TITLE - MATRA1 






0009 


• 


SQUARE 


: MATRIX TRANSPOSE 






0010 


* 










0011 


• 




MATRA1 TRANSPOSES A SQUARE, CLOSELY PACKED 


MATR6X j 


0012 


• 










0013 


* 


LANGUAGE - 


FAP SUBROUTINE (FORTRAN II COMPATIBLE) 






0014 


* 


EQUIPMENT - 


IBM 709 OR 7090 (MAIN FRAME ONLY) 






0015 


* 


STORAGE 


42 REGISTERS 






0016 


• 


SPEED 


ABOUT 11*LA*LA + 9*LA ♦ 50 MACHINE CYCLES 


ON 


THE 7090 


0017 


• 




WHERE LA IS NUMBER OF ROWS OR COLUMNS IN 


THE 


MATRIX. 


0018 


• 


AUTHOR 


R.A. WI6GINS 2/63 






0019 


* 










0020 


• 




—USAGE 






0021 


* 










0022 


• 


TRANSFER VECTOR CONTAINS ROUTINES - NONE 






0023 


• 


AND FORTRAN SYSTEM ROUTINES - NONE 






0024 


* 










0025 


* 


FORTRAN USAGE 






0026 


• 


CALL MATRAKLAt A) 






0027 


* 










0028 


• 


INPUTS 








0029 


• 










0030 


» 


AU) 


I=l.*.LA*LA IS A SQUARE, CLOSELY PACKED MATRIX. 


0031 


* 




I.E. AU...LA) CONTAINS COLUMN I, 






0032 


• 




A(LA+1...2»LA) CONTAINS COLUMN 2, 






0033 


» 




ETC. 






0034 


• 










0035 


• 


LA 


MUST BE GRTHN= 1 • 






0036 


* 




IS FORTRAN II INTEGER. 






0037 


• 










0038 


• 


OUTPUTS 








0039 


• 










0040 


• 


Ad) 


I=1...LA*LA IS THE MATRIX STORED BY ROWS. 






0041 


* 




I.E. A(l.*.LA) CONTAINS ROW I, 






0042 


» 




A(LA+1...2«LA) CONTAINS ROW 2, 






0043 


• 




ETC. 






0044 


* 










0045 


• 


EXAMPLES 








0046 


* 










0047 


• 


I. INPUTS - 


• LA*2 A(l.*.4) * I. ,2. ,3. ,4. 






0048 


* 










0049 


• 


OUTPUTS - AU...4) = l. f 3.,2.,4. 






0050 


• 










0051 


* 


PROGRAM FOLLOWS BELOW 






0052 


• 










0053 




HTR 


0 






0054 




BCI 


1,MATRA1 






0055 


MATRA1 SXD 


♦-2,4 






0056 




SXA 


EX# 1 






0057 




SXA 


EX*1,2 






0058 




CLA» 


1,4 GET 






0059 




STO 


LAA1 LA. 






0060 




STD 


T20 






0061 




ADD 


»1B17 






0062 




STD 


T21 






0063 




LDQ 


LAA1 






0064 




MPY 


LAA1 






0065 




ALS 


17 






0066 




STO 


LAA1 






0067 




CAL 


2,4 GET ADR(A) 






0068 




ADD 


=1 






0069 




STA 


A 






0070 




STA 


Ai 






0071 




STA 


A2 






0072 




STA 


A3 






0073 




LXD 


LAA1,1 LOAD 






0074 



* MATRA1 
(PAGE 2) 



PROGRAM LISTINGS 



#»*###»•*«*#* *•******•«• 
# MATRA1 * 
«••#**•»*»««**•**»••**»« 

( PAGE 2) 





LXD 


LAAl, 2 


INDICES, 


0075 




TRA 


T20 




0076 


A 


CIA 


»»♦! 


LOOP, 


0077 


Al 


LOQ 


*»,2 




0078 


A2 


STQ 


♦ •♦1 




0079 


A3 


STO 


• » f 2 




0080 


T20 


TIX 


T30,l ,** 


(LA) 


0081 




LXD 


LAAlt 1 




0082 


T21 


TIX 


T25,l,** 


(LA+l) 


0083 


EX 


AXT 


♦♦♦1 


EXIT. 


0084 




AXT 


***2 




0085 




LXD 


MATRAl-2,4 




0086 




TRA 


3,4 




0087 


T25 


SXD 


LAA1,1 




0088 




LXD 


LAAl, 2 




0089 




TRA 


T20 




0090 


T30 


TIX 


A, 2,1 




0091 




TRA 


EX 




0092 


LAAl 


PIE 
END 






0093 
0094 
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REFER TO REFER TO 

MAXSN MAXSN 



* MAXA8M * 
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REFER TO 

MAXSNM 
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* MAXA8M * 



REFER TO 

MAXSNM 
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• MAXSN * # MAXSN * 

**••••••••«•*«*»#«•••*** ^ ###»#*#*##•*#» *♦*#*»**♦ 

* MAXSN (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0169 

* FAP 0001 
♦MAXSN 0002 

COUNT 150 0003 

LBL MAXSN 0004 

ENTRY MAXSN (LX,XtXMAXl, I ) 0005 

ENTRY MINSN (LX,X,XMIN1» I ) 0006 

ENTRY MAXAB iLX, X,XMAX2, I ) 0007 

ENTRY MINAB CLX ,X ,XM IN2, I) 0008 

» 0009 

* ABSTRACT 0010 

« 0011 

* TITLE - MAXSN , WITH SECONOARY ENTRY POINTS MINSN* MAXA8, AND MINA8 0012 
» FIND SIGNED OR UNSIGNED EXTREMAL VALUES OF A VECTOR. 0013 

* 0014 
» MAXSN FINDS THE MAXIMUM SIGNED NUMBER, AND ITS INDEX, IN 0015 

* A VECTOR OF NUMBERS (EITHER FIXED OR FLOATING POINT). 0016 

* 0017 

* MINSN FINDS THE MINIMUM SIGNED NUMBER. 0018 
» 0019 
» MAXAB FINDS THE MAXIMUM OF THE ABSOLUTE VALUES. 0020 

* 0021 
» MINAB FINDS THE MINIMUM OF THE ABSOLUTE VALUES. 0022 
» 0023 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0024 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0025 

* STORAGE - 54 REGISTERS 0026 

* SPEED - APPROX. 14N MACHINE CYCLES, N = LENGTH OF VECTOR 0027 
» AUTHOR - J.F. CLAERBOUT 0028 
» 0029 

» -USAGE 0030 

» 0031 

» TRANSFER VECTOR CONTAINS ROUTINES - NONE 0032 

» AND FORTRAN SYSTEM ROUTINES - NONE 0033 

* 0034 
« FORTRAN USAGE FOR MAXSN 0035 

* CALL MAXSN C LX, X, XMAX1, I ) 0036 

* 0037 

* INPUTS 0038 

* 0039 

* X(I) 1=1. ..LX IS A VECTOR OF NUMBERS. 0040 

* MAY BE FIXED OR FLOATING POINT. 0041 

* 0042 

* LX IS FORTRAN II INTEGER. 0043 

* MUST BE GRTHN-1. 0044 
» 0045 
« OUTPUTS 0046 

* 0047 

* XMAX1 IS THE MAXIMUM SIGNED VALUE IN THE X VECTOR. 0048 

* 0049 

* I IS THE INDEX OF THE MAXIMUM SIGNED VALUE. 0050 
« I.E. X(I) = XMAX1 0051 
« 0052 

* FORTRAN USAGE FOR MINSN 0053 
» CALL MINSN CLX,X, XMIN1, I ) 0054 
» 0055 

* INPUTS SAME AS FOR MAXSN 0056 

* 0057 
« OUTPUTS 0058 

* 0059 

* XMIN1 IS THE MINIMUM SIGNED VALUE IN THE X VECTOR 0060 

* 0061 
« I IS THE INDEX OF THE MINIMUM SIGNED VALUE. 0062 
» 0063 
» FORTRAN USAGE FOR MAXAB 0064 

* CALL MAXAB ( LX,X ,XMAX2, I ) 0065 
» 0066 
» INPUTS SAME AS FOR MAXSN 0067 

* 0068 
« OUTPUTS 0069 

* 0070 

* XMAX2 IS THE MAXIMUM ABSOLUTE VALUE IN THE X VECTOR. 0071 
» NOTE THAT XMAX2 MAY BE NEGATIVE. 0072 
» 0073 
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• 


I 




IS THE INDEX OF THE MAXIMUM ABSOLUTE VALUE. 


UU I f 


• 








UU f !> 


• FORTRAN USAGE FOR MINAB 


UU f o 


• 


CALL MINAB (LX, X,XMIN2, I) 


UU I I 


• 








0078 


» INPUTS 




SAME AS FOR MAXSN 


0079 


• 








0080 


* OUTPUTS 






008 1 


• 








0082 


• 


XMIN2 




IS THE MINIMUM ABSOLUTE VALUE IN THE X VECTOR* 


0083 


• 






Tij i t \/ lj T ai "> aj A w n in r* r* a y fur 

NOTE THAT XMIN2 MAY BE NEGATIVE* 


AAQA 

UUOH 


• 








008*5 


• 


I 




IS THE INDEX OF THE MINIMUM ABSOLUTE VALUE* 


0086 


» 








0087 


* EXAMPLES 






fin no 










rtrto q 

UU0 7 


* 1* 


I NPUTS 




XI1...10) = — 11*,— 8**— 5*, — 2*, 1* ,4* » 7** 10* § 13* * lo* 


nnon 

UU7U 








LX = 10 


AAQ 1 




nc Arc 




rill y A V C K1 J | v \/ V M A V 1 Tit 

LALL MAXSN ( LX , X , aMAX 1 , I 1 J 


0092 


• 






CALL MINSN I LX,X,XMINl* 12 J 




• 






LALL MAXAB 1 LX, X , XMAXZ, 1 3 I 


rt AOA 


• 






LALL MINAB X LX • X t XM 1N2» 1 4J 


nnnc 


• 


OUTPUTS 




XMAX1 = 16* 11 = 10 


rtrtOA 


• 






XMIN1 =—11* 12 * 1 


UU7 1 


* 






XMAXZ ~ lo* 13 * 10 


UU70 


* 






ahIiNZ — 1* in = !> 


WV77 


• 








rti nrt 
U1UU 


• 2. 


INPUTS 




VI I tni Is .1 t\ _U -| r\ -7 /, 1 •> «? Q 1 1 1>. $ 


UlUl 


* 






LX = 10 


rt i rt o 
UlUi 


• 


USAGE 




SAME AS EXAMPLE 1* 


0103 


* 


OUTPUTS 




uuiui _ ii *i _ 1 r» 

XMAX1 = 11* 11 = 10 


01 04 


• 






XMIN1 =— 16* 12 - 1 


0105 


• 






XMAX2 =-16* 13= 1 


rti r»A 


* 






XMIN2 = —1* 14 = 6 


U1U f 


* 








0108 


* 3. 


INPUTS 




Xll**«10J = — 16,— 13f-*10t**7f— 4f — It 2t5t-8»ll LX = 10 


rt 1 AO 
U1U7 


• 


USAGE 




SAME AS EXAMPLE 1* 


01 1 0 


* 


OUTPUTS 




XMAX1 = 11 11 - 10 


U 1 1 1 


* 






XMIN1 =—16 12 = 1 


Ul 1 £ 


» 






XMAX2 =-16 I 3 = 1 


All 1 

Ui i J 


• 






XMIN2 = -1 14 = 6 


0114 


• 








01 1 5 




HTR 




0 


0116 




BCI 




ItMAXSN 


0117 


MAXSN CLA 




MX 


01 1 8 




STO 




USE 


01 19 




TRA 




♦♦3 


UltU 


MINSN CLA 




MN 


rti "7 1 




STO 




USE 


0122 




CLA 




NOP 


0123 




STO 




A-l 


0124 




CLA 




SUB 


ni *>k 

V Lc.0 




STO 




A 


rti ot 




TRA 




START 


rti ">"7 


MAXAB CLA 




MX 


0128 




STO 




USE 


moo 




TRA 




*+3 


rti ■an 
UI 3U 


MINAB CLA 




MN 


0131 




STO 




USE 


01 32 




CLA 




SSP 


U 1 3 3 




STO 




A— 1 


rti 




CLA 




SBM 


0135 




STO 




A 


0136 


START SXA 




SV#1 


0137 




SXD 




MAXSN-2,4 


rti *\tt 

Ul JO 




CLA* 




1,4 


0139 




PDX 




tl ARRAY LENGTH TO IR1 


0140 




CLA 




2.4 


0141 




ADO 




= 1 


0142 




STA 




A+2 


0143 




STA 




A 


0144 




CLA* 




2*4 GET TRIAL 


0145 




STO* 




3,4 EXTREMUM 


0146 




CLA 




=1 SET CORRECT INDEX FOR TRIAL EXTR8MUM 


0147 




ALS 




18 


0148 
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STO 


INDEX 


LOOP 


CLA* 


3,4 




HTR 


0 


A 


HTR 


**,1 


USE 


HTR 


B 




CLA 


**,1 




STO* 


3,4 




SXD 


INDEX, 1 


B 


TIX 


LOOP, 1,1 




CLA 


INDEX 




STO* 


4,4 


SV 


AXT 


**,1 




TRA 


5,4 


NOP 


NOP 




SUB 


SUB 


0,1 


SSP 


SSP 




SBM 


SBM 


0,1 


*X 


TPL 


B 


MN 


TMI 


B 


INDEX 


BSS 
END 


1 



EITHER NOP OR SSP 
EITHER SUB OR SBM 
EITHER TPL OR TMI 



0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
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* MAXSNM • 
***#»«**•***•««•**••*#•* 



» MAXSNM ( SUBROUTINES ) 9/4/64 LAST CARD IN DECK IS NO* 0246 

« FAP 0001 

•MAXSNM 0002 

COUNT 200 0003 

LBL MAXSNM 0004 

ENTRY MAXSNM ( FOFIJ, L I,L J, IDIMEN, FMAXSN, IMAXSN, JNAXSN) 0005 

ENTRY MINSNM CFOF I J,LI ,L J, IDIMEN,FMINSN, IMINSN, JNINSN ) 0006 

ENTRY MAXABM CFOFI J, LI ,L J, IDIMEN, FMAXAB, IMAXAB, JMAXA8 ) 0007 

ENTRY MINABM CFOFI J, LI ,LJ, IDIMEN, FMINAB, IMINAB, JMINAB) 0008 

* 0009 

* 0010 
» + ABSTRACT — 0011 

* 0012 

* TITLE - MAXSNM, WITH SECONDARY ENTRIES MINSNM, MAXABM* AND MINABM 0013 
» EXTREMAL VALUES OF MATRIX ELEMENTS 0014 
» 0015 

* MAXSNM FINDS THE LARGEST ELEMENT OF A MATRIX. 0016 

* MINSNM FINDS THE SMALLEST ELEMENT OF A MATRIX. 0017 
» MAXABM FINDS THE ELEMENT WHOSE MAGNITUDE IS LARGEST, 0018 

* MINABM FINDS THE ELEMENT WHOSE MAGNITUDE IS SMALLEST. 0019 

* 0020 

* THE FORTRAN INDICES OF THE EXTREMAL VALUE ARE ALSO 0021 
» GIVEN AS OUTPUTS. THE MATRIX ELEMENTS MAY BE FIXED 0022 
» OR FLOATING POINT. 0023 

* 0024 

* LANGUAGE - FAP SUBROUTINE, FORTRAN II COMPATIBLE 0025 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0026 

* STORAGE - 61 REGISTERS 0027 

* SPEED - APPROXIMATELY 14N MACHINE CYCLES, WHERE N f S THE 0028 

* NUMBER OF ELEMENTS IN THE MATRIX. 0029 
» AUTHOR - S.M. SIMPSON, MARCH 1964 0030 

* (BASED ON THE VECTOR VERSION, MAXSN, BY J. CLAf RB0UT9 0031 
» 0032 
« 0033 

* 0034 

* USAGE-* 0035 

* 0036 

* TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0037 

* AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0038 

* 0039 

* FORTRAN USAGE 0040 
« CALL MAXSNMIF0F1J, LI, LJ, IDIMEN, FMAXSN, IMAXSN, dMAXSN) 0041 
« CALL MINSNMCFOFIJ, LI, LJ, IDIMEN, FMINSN, IMINSN, JMINSNJ 0042 

* CALL MAXABM! FQF f J , LI, LJ, IDIMEN, FMAXAB, IMAXAB, JMAXABI 0043 

* CALL MINABMIF0F1J, LI, LJ, IDIMEN, FMINAB, IMINAB, JMINAB) 0044 

* 0045 
» 0046 
» INPUTS TO ALL ENTRIES 0047 
» 0048 

* FOFIJ(I,J) 1=1. w.LI, J-1...LJ IS THE MATRIX TO BE SCANNED. ITS 0049 

* MODE MAY BE EITHER FLOATING POINT OR FIXED ROINTi 0050 
» 0051 

* LI MUST EXCEED ZERO (NOT CHECKED). 0052 

* 0053 
» LJ MUST EXCEED ZERO (NOT CHECKED). 0054 

* 0055 
» IDIMEN IS THE CALLER'S DIMENSION FOR THE INDEX I IN 0056 

* F0F1J(I,J). 0057 

* MUST BE GRTHN= LI (NOT CHECKED). 0058 

* 0059 
» 0060 

* OUTPUTS FROM MAXSNM 0061 
» 0062 

* FMAXSN IS A VALUE SELECTED FROM THE MATRIX SUCH THAT 0063 

* FMAXSN GRTHN* FOFIJ(I,J) OVER 1=1. .-II* J*1#..LJ. 0064 
» 0065 

* IMAXSN, JMAXSN ARE INDICES FOR WHICH 0066 
» FOFI JUMAXSN, JMAXSN) * FMAXSN. 0067 
» 0068 
» 0069 

* OUTPUTS FROM MINSNM 0070 
» 0071 

* FMINSN IS A VALUE SELECTED FROM THE MATRIX SUCH THAT 0072 
» FMINSN LSTHN= FOFIJ(I,J) OVER I*l.i.LU J*l*l«LJd 0073 

* 0074 
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» IMINSN, JMINSN ARE INDICES FOR WHICH 0075 

* FOFI J { IMINSN, JMINSN) * FMINSN. 0076 

* 0077 
« 0078 

* OUTPUTS FROM MAXABM 0079 

* 0080 
» FMAXAB IS A VALUE SELECTED FROM THE MATRIX SUCH THAT 0081 

* // FMAXAB // GRTHN= FOFIJU,J) OVER 1*1.*. LI, 0082 

* J*1...LJ 0083 

* WHERE // // STANDS FOR ABSOLUTE VALUE. 0084 

* NOTE THAT FMAXAB MAY BE NEGATIVE. 0085 
» 0086 

* IMAXAB, JMAXAB ARE INDICES FOR WHICH 0087 
» FOFI J< I MAX A B, JMAXAB ) * FMAXAB. 0088 

* 0089 

* 0090 

* OUTPUTS FROM MINABM 0091 
» 0092 
» FMINAB IS A VALUE SELECTED FROM THE MATRIX SUCH THAT 0093 

* // FMINAB // LSTHN- FOFI J( I, J) OVER 1=1. ..LI, 0094 

* J=l...LJ . 0095 

* NOTE THAT FMINAB MAY BE NEGATIVE. 0096 
« 0097 

* IMINAB, JMINAB ARE INDICES FOR WHICH 0098 

* FGFI J( IMINAB, JMINAB ) * FMINAB* 0099 

* 0100 
« 0101 
» CHOICE OF VALUES IN CASE OF DUPLICATE EXTREMALS 0102 
« 0103 
» FOR ALL ENTRIES THE ORDER OF SCANNING IS, IN TERMS OF THE INDICES 0104 
» I, J, LI. ..1*1 LI... 1,2 ETC. LI...1,LJ . 0105 
» IF THE EXTREMAL VALUE OCCURS MORE THAN ONCE THE INDICES SELECTED 0106 

* FOR OUTPUT CORRESPOND EITHER TO THE FIRST OR TO THE LAST OCCURRENCE 0107 

* OF THE VALUE IN THIS SCAN ORDER, ACCORD I KG TO THE FOLLOWING TABLE* 0108 
» 0109 

* EXTREMAL POSITIVE EXTREMAL NEGATIVE 0110 

* MAXSNM FIRST LAST 0111 

* MINSNM LAST FIRST 0112 

* MAXABM FIRST FIRST 0113 

* MINABM LAST LAST 0114 
» 0115 

* 0116 

* EXAMPLES 0117 
» 0118 
« 1. INPUTS - F( l.*.3,1...3> = 5. ,-2. ,8.,, 3., 2., 4.,, -12. ,-5. ,-12. 0119 
» USAGE - DIMENSION FC5,3) 0120 
« 00 10 LJ=1,3 0121 
» DO 10 LI=1,3 0122 

* CALL MAXSNMCF, LI, LJ, 5, F1(LI,LJ), IKLULJ1, 0123 

* 1 Jl(LI,LJ)) 0124 

* CALL MINSNMCF, LI, LJ, 5, F2(LI,LJ>, I2(LI,LJJ, 0125 

* I J2(LI,LJ)) 0126 

* CALL MAXABMCF, LI, LJ, 5, F3(LI,LJ), I3(LI*LJJ, 0127 

* 1 J3(LI,LJ)> 0128 
» 10 CALL MINABMt F, LI, LJ, 5, F4(LI,LJ), I4(LULJ>t 0129 
« 1 J4(LI,LJH 0130 

* 0131 

* OUTPUTS - (FOR LI * 1 2 3,, 1 2 3,, 1 2 31 0132 

* Fl(1...3,l..«3) - 5., 5., 8.*, 5., 5., 8.,, 5.* 5. t 8i 0133 
» 11(1. ..3,1. ..3) = 1, 1, 3,, I, 1, 3,, l« 1, 3 0134 
» Jl(1...3,i...3> » l f l f i 99 1, 1. l ff 1* It 1 0135 
» F2(1...3,U..3) = 5., -2., -2., ,3., -2., -2.,, -12. #-12. ,-12. 0136 

* I2( 1...3, 1...3) * I, 2, 2,, 1, 2, 2,, It 1* 3 0137 
» J2(1...3,1...3) * 1, 1, 1,, 2, 1, I,, 3, 3, 3 0138 

* F3(1...3,1...3> « 5., 5., 8. ,,5., 5., 8. , ,-12. #-12. ,-12. 0139 
» 13(1. ..3,1. ..3) * 1, 1, 3,, 1, 1, 3,, 1* 1# 3 0140 
» J3(1...3,1...3) = 1, 1, 1,, 1, 1, 1,, 3* 3, 3 0141 
» F4(1...3,1...3) = 5. ,-2. ,-2. ,,3., 2., 2.,, 3., 2., 2. 0142 

* I4(1...3,1...3> = 1, 2, 2,, 1, 2, 2,, 1* 2, 2 0143 

* J4(1...3,1...3) » 1, 1, 1,, 2, 2 r 2,, 2, 2, 2 0144 
» 0145 

* 2. INPUTS - IFtl...3,1...3) = 5,-2,8,, 3,2,4,, -12,-5,-12 0146 
« USAGE - SIMILAR TO EXAMPLE 1., REPLACING F BY IF, Fl BY 1F1, 0147 
» ETC. 0148 
« OUTPUTS - SIMILAR TO EXAMPLE 1., EXCEPT IF1, IF2, WILL BE 0149 
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* FIXED POINT. 0150 

* 0151 
» PROGRAM FOLLOWS BELOW 0152 

* 0153 

* NO TRANSFER VECTOR 0154 

* 0155 
HTR 0 XR4 0156 
8CI I, MAXSNM 0157 

* 0158 

* PRINCIPAL ENTRY* MAXSNMfFOFI J,LI ,LJ, IDIMEN, FMAXSN, IMAXSN, JMAXSNt 0159 

* 0160 
MAXSNM CLA MX 0161 

TRA MINSNM+1 0162 

* 0163 
» SECOND ENTRY. MINSNMCFOFIJ, LI ,LJ, IDIMEN,FMINSN, IMINSN, JMINSN) 0164 

* 0165 
MINSNM CLA MN 0166 

STO TEST 0167 

CLA NOP 0168 

LDQ SUB 0169 

TRA MERGE 0170 

* 0171 

* THIRD ENTRY. MAXABMt FOF I J, L I tL Jt ID IMEN,FMAXABt IMAXA8, JMAXAB ) 0172 
» 0173 
MAXABM CLA MX 0174 

TRA MINABM+1 0175 

* 0176 

* FOURTH ENTRY. MINABMt FOFIJ , LI ,LJ, IDIMEN, FMINAB, IMINAB, JMINAB) 0177 

* 0178 
MINABM CLA MN 0179 

STO TEST 0180 

CLA SSP 0181 

LDQ SBM 0182 

* 0183 

* FINISH SETTING UP THE LOOP INSTRUCTIONS. 0184 

* 0185 
MERGE STO SIGN 0186 

STQ DIFF 0187 

SXD MAXSNM-2,4 0188 

SXA LEAVE, I 0189 

SXA LEAVE+1,2 0190 

CLA 1,4 A(FOFIJ) 0191 

ADD Kl 0192 

STA DIFF 0193 

CLA* 4,4 IDIMEN 0194 

ARS 18 0195 

STA IDIM 0196 

* 0197 

* SET XR2 TO COUNT J * 1,2,...,LJ 0198 

* XR1 TO COUNT I * LI,LI-1,...,1 0199 

* THEN ENTER LOOP SO THAT FIRST TRIAL IS SET « FOFIJ<LI,lt 0200 

* 0201 
CLA* 2,4 LI 0202 
PDX 0,1 0203 
CLA* 3,4 LJ 0204 
STD TXL 0205 
A XT 1,2 0206 
TRA CLADIF 0207 

LOOP CLA* 5,4 FMAXAB OR FMINAB OR ETC 0208 

SIGN NOP NOP OR SSP 0209 

DIFF NOP SUB**,1 OR SBM**,1 ** = A*F0FIJ)+1 (-1DIM,...) 0210 

TEST NOP TPL TIX OR TMI TIX 0211 

* 0212 

* REPLACE FMAXAB BY NEW TRIAL IF FALLS THRU TEST 0213 

* 0214 
CLADIF CLA* DIFF 0215 

STO* 5,4 NEW TRIAL STORED 0216 

PXD 0,1 0217 

STO* 6,4 NEW I STORED 0218 

PXD 0,2 0219 

STO* 7,4 NEW J STORED 0220 

TIX TIX LOOP, 1,1 0221 

* 0222 

* RESET FOR NEXT LINE 0223 

* 0224 
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CAL 


DIFF 


(NOTE DIFF MAY BE NEG OR POS t 


0225 




SUB 


IDIM 




0226 




STA 


DIFF 




0227 




CLA* 


2,4 


RESET XRl TO LI 


0228 




PDX 


0,1 




0229 




TXI 


*+l,2,l 




0230 


TXL 


TXL 


L00P,2,»* 


♦ ♦ = LJ 


0231 


LEAVE 


AXT 






0232 




AXT 


**,2 




0233 




TRA 


8,4 




0234 










0235 


CONSTANTS, 


VARIABLES 




0236 










0237 


NOP 


NOP 






0238 


SUB 


SUB 






0239 


SSP 


SSP 






0240 


SBM 


SBM 


♦♦,1 




0241 


MX 


TPL 


TIX 




0242 


MN 


TMI 


TIX 




0243 


Kl 


PZE 


1 




0244 


IDIM 


PZE 


•* 


** - IDIMEN 


0245 




END 






0246 
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• MDOT (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO* 0093 

» LABEL 0001 

CMDOT 0002 
SUBROUTINE MOOT (N, L, AA,BB,CC, ORDER) 0003 

C 0004 

C '-ABSTRACT 0005 

C 0006 

C TITLE - MDOT 0007 

C DOT PRODUCT OR REVERSED DOT PRODUCT OF VECTORS OIF MATRICES 0008 

C 0009 

C MDOT FINDS THE DOT PRODUCT 0010 

C 0011 

C C * AUMBU) ♦ •.. ♦ A<L)*B(L) 0012 

C 0013 

C OR THE REVERSED DOT PRODUCT 0014 

C 0015 

C C * AC1)*B(L) + ... ♦ A<L)*BU) 0016 

C 0017 

C OF TWO VECTORS OF N X N MATRICES A{K) AND 8(K)J THE 0018 

C MATRICES ARE ASSUMED TO BE STORED BY COLUMNS AND 0019 

C CLOSELY PACKED. 0020 

C 0021 

C LANGUAGE - FORTRAN II SUBROUTINE 0022 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0023 

C STORAGE - 109 REGISTERS 0024 

C SPEED - ABOUT (18*L)*N«N«N + U2«L~3)«N*N ♦ II0«U4J*N * 104»L 0025 

C ♦ 117 MACHINE CYCLES ON THE 7090. 0026 

C AUTHOR - R.A. WIGGINS 3/63 0027 

C 0028 

C —USAGE 0029 

C 0030 

C TRANSFER VECTOR CONTAINS ROUTINES - MATML1 0031 

C AND FORTRAN SYSTEM ROUTINES - NONE 0032 

C 0033 

C FORTRAN USAGE 0034 

C CALL MDOT < N, L# AA, B8,CC, ORDER) 0035 

C 0036 

C INPUTS 0037 

C 0038 

C N IS THE DIMENSION OF THE MATRICES IN THE A AND B VECTORSi 0039 

C MUST BE GRTHN- 1 0040 

C 0041 

C L IS THE NUMBER OF MATRICES IN THE A AND B VECTORSi 0042 

C MUST BE GRTHN* 1 0043 

C 0044 

C AAU) I=1,...,L*N*N CONTAINS THE VECTOR OF MATRICES AU* 0045 

C THROUGH A(L) STORED CLOSELY PACKED BY COLUMNS. 0046 

C 0047 

C 8BU) I«1,...,L*N*N CONTAINS THE VECTOR OF MATRICES 8(1) 0048 

C THROUGH B(L) STORED CLOSELY PACKED BY COLUMNS. 0049 

C 0050 

C ORDER IF GRTHN 35 0 THE DOT PRODUCT IS FOUND. 0051 

C IF LSTHN 0 THE REVERSE DOT PRODUCT IS FOUND. 0052 

C 0053 

C OUTPUTS 0054 

C 0055 

C CC(I) I=1,*.*,N*M CONTAINS THE DOT PRODUCT C AS DESCRIBED 0056 

C IN THE ABSTRACT, STORED BY COLUMNS. 0057 

C 0058 

C EXAMPLES 0059 

C 0060 

C 1. INPUTS - N=l L*3 AAU. ..3) * l.,2.,3. BBU...33 * l.#~l.,-4. 0061 

C 0RDER=1. 0062 

C OUTPUTS - CCii) » -13. 0063 

C 0064 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT 0RDER=*-1. 0065 

C OUTPUTS - CCCi) » -3. 0066 

C 0067 

C 3. INPUTS - N=2 L*2 AAU. ..8) = 1., 2. , I. , 2. , 3.,4. , 3. |4. 0068 

C ORDER-1 • BBU...8) » 2.,2.,2., 2.,4.,4. f 4.*4. 0069 

C OUTPUTS - CCU..i4) « 28 . , 40. , 28. ,40. 0070 

C 0071 

C 4. INPUTS - SAME AS EXAMPLE 3. EXCEPT 0RDER=-1. 0072 

C OUTPUTS - CCii. -.4) « 20. ,32. ,20. ,32. 0073 

C 0074 
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C PROGRAM FOLLOWS BELOW 
C 

DIMENSION AA(10),BB(10),CC(10) 

M=0 

N1=N 

NN=N1*N1 
NN1=NN 
K=l 
J=l 

IF C ORDER) 10,20,20 
10 K=(L-1)*NN+1 

NNl=— NN 
20 DO 100 1*1, L 

CALL MATML1 (N1,AA( J} ,BB(K),CC,M) 

J=J+NN 

K=K+NNi 
100 M=l 

RETURN 

END 
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0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
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* MDOT3 (SUBROUTINE) 9/29/64 LAST CARO IN DECK IS NO. 0119 

» LABEL OOOl 

CMD0T3 0002 
SUBROUTINE MD0T3 I N,M, L, L AB, AA, BB,TR AN, CC, ORDER ) 0003 

C 0004 

C -ABSTRACT 0005 

C 0006 

C TITLE - MD0T3 0007 

C DOT PRODUCT OR REVERSED DOT PRODUCT OF VECTORS OF MATRICES 0608 

C 0009 

C MOOT FINDS THE DOT PRODUCT 0010 

C 0011 

C C « A(1)#BU) ♦ ... ♦ A( LAB) *B( LAB) 0012 

C 0013 

C OR 0014 

C 0015 

C C « Atl)»B(l) + ... + A (LAB) *B( LAB) B * B TRANSPOSE 0016 

C 0017 

C OR THE REVERSED DOT PRODUCT 0018 

C 0019 

C C « A(I)»B«LAB) ♦ ... ♦ A(LAB)*B(1) 0020 

C 0021 

C OR 0022 

C 0023 

C C = Atl)*B(LAB) + 4 A(LAB)*B(1) 0024 

C 0025 

C WHERE A ( K) IS A VECTOR OF N X M MATRICES STORED BY 0026 

C COLUMNS AND B(K) IS A VECTOR OF M X N MATRICES STORED 0027 

C BY COLUMNS OR BY ROWS. BOTH VECTORS ARE CLOSELY PACKED. 0028 

C 0029 

C LANGUAGE - FORTRAN II SUBROUTINE 0030 

C EQUIPMENT - 709, 7090, 7094 (MAIN FRAME ONLY) 0031 

C STORAGE - 122 REGISTERS 0032 

C SPEED - ABOUT M<18«M+98)*N +14)*L ♦ 147)«LAB ♦ 133 MACHINE 0033 

C CYCLES ON THE 7094 IF THE VERSION OF MATML3 WRITTEN 0034 

C MARCH, 1963, IS USED. 0035 

C AUTHOR - R.A« WIGGINS 3/63 0036 

C 0037 

C -USAGE 0038 

C 0039 

C TRANSFER VECTOR CONTAINS ROUTINES - MATML3 0040 

C AND FORTRAN SYSTEM ROUTINES - NONE 0041 

C 0042 

C FORTRAN USAGE 0043 

C CALL MD0T3 ( N,M,L, LAB, AA,BB,TRAN,CC, ORDER) 0044 

C 0045 

C INPUTS 0046 

C 0047 

C N IS THE NUM8ER OF ROWS IN THE MATRICES IN AJ 0048 

C MUST BE GRTHN- I 0049 

C 0050 

CM IS THE NUMBER OF COLUMNS IN THE MATRICES IN A AND B 0051 

C ('AFTER TRANSPOSITION) 0052 

C MUST 8E GRTHN= 1 0053 

C 0054 

C L IS THE NUMBER OF ROWS IN THE MATRICES IN B (AFTER 0055 

C TRANSPOSITION) 0056 

C MUST BE GRTHN= 1 0057 

C 0058 

C LAB IS THE NUMBER OF MATRICES IN THE A AND B VECTORS.! 0059 

C MUST BE GRTHN=1 0060 

C 0061 

C AA(I) I = 1,*.<J,LAB*N*M CONTAINS THE VECTOR OF MATRICES AM) 0062 

C THROUGH A ( L ) STORED CLOSELY PACKED BY COLUMNS. 0063 

C 0064 

C BBII) I*i,..^,LAB#M*L CONTAINS THE VECTOR OF MATRICES B(ll 0065 

C THROUGH B(L) STORED CLOSELY PACKED. 0066 

C 0067 

C TRAN IF - 0. B IS ASSUMED TO BE STORED BY COLUMNS. 0068 

C IF NOT* 0. B IS ASSUMED TO BE STORED BY ROWS ASD THE DOT 0069 

C PRODUCT OF B TRANSPOSE IS FOUND. 0070 

C 0071 

C ORDER IF GRTHN-0 THE DOT PRODUCT IS FOUND. 0072 

C IF LSTHN 0 THE REVERSE OCT PRODUCT IS FOUND. 0073 

C 0074 
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C OUTPUTS 0075 

C 0076 

C CCU) I=l,..w,N»L CONTAINS THE DOT PRODUCT C AS DESCRIBED 0077 

C IN THE ABSTRACT, STORED BY COLUMNS, 0078 

C 0079 

C EXAMPLES 0080 

C 0081 
C 1. INPUTS - N=l M=l L=l LAB-3 AA(1...3)=l.,2.t3. BU..J3) =n.#-l.,-4. 0082 

C ORDER 35 !. TRAN^O. 0083 

C OUTPUTS - CCU) * -13. 0084 

C 0085 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT 0RDER=-1. 0086 

C OUTPUTS - CCU) = -3. 0087 

C 0088 

C 3. INPUTS - L AB=2 AAU...8) * H , 2 . , 1 . , 2. , 3. ,4. , 3. #4. N*2 M*2 0089 
C ORDER= 1 . BBU...8) » 2., 2., 3. ,2.,4.,1.,4. |4. fc*2 TRAN=0. 0090 

C OUTPUTS - CCU. ..4) = 19. , 28. , 29 . , 42 . 0091 

C 0092 

C 4. INPUTS - SAME AS EXAMPLE 3. EXCEPT ORDER * -1. 0093 

C OUTPUTS - CCU. ..4) = 17 . , 26. , 23. , 36. 0094 

C 0095 

C 5. INPUTS - SAME AS EXAMPLE 3. EXCEPT TRAN = U 0096 

C OUTPUTS - CCU*. .4) = 29. , 42. , 19. , 28 . 0097 

C 0098 

C 6. INPUTS - SAME AS EXAMPLE 3. EXCEPT ORDER = -1. TRAN * 1. 0099 

C OUTPUTS - CCU. . .4) = 23. , 36. , 17. , 26. 0100 

C 0101 

C PROGRAM FOLLOWS BELOW 0102 

C 0103 

DIMENSION AAU0),BBU0),CC(10) 0104 

M1=0 0105 

IDA=N*M 0106 

IDB=M«L 0107 

J=l 0108 

K=i 0109 

IF t ORDER) 10,40,40 0110 

10 K=(LAB-1)*IDB+1 0111 

IDB=-IDB 0112 

40 DO 100 1*1, LAB 0113 

CALL MATML3 (N , M , L , AA( J ) , BB< K ) ,TRAN,CC, Ml ) 0114 

J=J+IDA 0115 

K=K+I DB 0116 

100 M1=M1+1 0117 

RETURN 0118 

END 0119 
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♦ MEMUSE (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO. 0068 

• LABEL 0001 
CMEMUSE 0002 

SUBROUTINE MEMUSE ( ITPOUT ) 0003 

C 0004 

C 0005 

C ABSTRACT — — 0006 

C 0007 

C TITLE - MEMUSE 0008 

C OFF-LINE PRINT OF MEMORY USAGE - PROGRAM AND COMMON 0009 

C 0010 

C MEMUSE PRINTS ONE LINE ON A SPECIFIED TAPE UN IT GIVING 0011 

C TOTAL PROGRAM STORAGE, TOTAL DIMENSIONED COMMON SPACE. 0012 

C AND REMAINING AVAILABLE COMMON SPACE. IT IS APPLICABLE 0013 

C ONLY UNDER THE FORTRAN MONITOR SYSTEM. 0014 

C 0015 

C LANGUAGE - FORTRAN-II SUBROUTINE 0016 

C EQUIPMENT - 709,7090,7094 (MAIN FRAME PLUS 1 TAPE DRIVE) 0017 

C STORAGE - 71 REGISTERS 0018 

C SPEED - TAKES TIME REQUIRED TO OUTPUT ONE 95 CHAR. BCD RECORD 0019 

C AUTHOR - S.M. SIMPSON, JUNE 1964 0020 

C 0021 

C 0022 

C -* USAGE 0023 

C 0024 

C TRANSFER VECTOR CONTAINS ROUTINES - XLCOMN 0025 

C AND FORTRAN SYSTEM ROUTINES - (STH), (FID 0026 

C 0027 

C FORTRAN USAGE 0028 

C CALL MEMUSE( ITPOUT) 0029 

C 0030 

C 0031 

C INPUTS 0032 

C 0033 

C ITPOUT IS THE LOGICAL TAPE NUMBER FOR OUTPUT 0034 

C 0035 

C 0036 

C OUTPUTS A ONE-LINE MESSAGE IS PRINTED AS ILLUSTRATED BELOW 0037 

C 0038 

C 0039 

C EXAMPLES 0040 

C 0041 

C 1. USAGE - SUPPOSE THAT THE FOLLOWING MAIN PROGRAM IS OPERATED* 0042 
C AND THAT THE MAIN PROGRAM PLUS MEMUSE, EXIT AND LOWER 0043 
C LEVEL ROUTINES OCCUPY OCTAL LOCATIONS 144 THROUGH 4523. 0044 

C DIMENSION C(2000) 0045 

C COMMON C 0046 

C CALL MEMUSE(2) 0047 

C CALL EXIT 0048 

C END 0049 

C OUTPUTS - ONE LINE (COLUMNS 2 THRU 95) IS FORMED ON LOGICAL 2 AS 0050 

C FOLLOWS. 0051 

C MEMORY USAGE (DECIMAL) - 2288 FOR PROGRAM, 0052 

C 2000 FOR DIMENSIONED COMMON, 0053 

C 28174 UNUSED COMMON 0054 

C 0055 

C 0056 

C PROGRAM FOLLOWS BELOW 0057 

C 0058 

C NOTE - 32,462 DECIMAL = 100,000 - 144 -(77,777-77,461) OCTAL 0059 

C 0060 

LDCOM * XLC0MNFC1.O) 0061 

LUCOM ■» XLCOMNFIO.O) - LDCOM 0062 

LPROG = 32462 - LUCOM - LDCOM 0063 

WRITE OUTPUT TAPE ITPOUT, 70, LPROG, LDCOM, LUCOM 0064 

70 F0RMAT(26H MEMORY USAGE (DECIMAL) - , 15, 13H FOR PROGRAMS 16, 0065 

1 24H FOR DIMENSIONED COMMON,, 16, 14H UNUSED COMMON) 0066 

9999 RETURN 0067 

END 0068 
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» MFACT ISUBROUT1NE) 9/29/64 LAST CARO IN ©fCK IS NO* 0102 

» LABEL 0G01 

C MFACT 0002 

SUBROUTINE MFACT *N,AA,BB) 0003 

C 0004 

C -—-ABSTRACT 0005 

C 0006 

C TITLE - MFACT 0007 

C FACTOR A SYMMETRIC POSITIVE DEFINITE MATRIX 0008 

C 0009 

C MFACT FINOS A TRIANGULAR MATRIX BII,J) (I REFERS TO THE 0010 

C ROW^ J REFERS TO THE COLUMN ) SUCH THAT 0011 

C 0012 

C A * B * (B TRANSPOSE) 0013 

C 0014 

C WHERE A IS A SQUARE, POSITIVE DEFINITE MATRIX. 0015 

C 0016 

C THE FACTORIZATION IS MADE ACCORDING TO THE SCHEME 0017 

C 0018 
C (0 I GRTHN J 0019 

C ( 0020 

C ( N 0021 

C ( <AIJ,J)-SUM <B< I,K)»BC I,K)))**.5 I * J 0022 

C BlItJ}*< K=J+1 0023 

C ( 0024 

C ( N 0025 

C ( (AUtJI-SUM (BtI»K)»B(K v J)))/BC J4J) I LSTHN J 0026 

C ( K-J + l 0027 

C 0028 

C WHERE N IS THE NUMBER OF ROWS AND COLUMNS AND THE 0029 

C CALCULATION PROCEEDS AS 0030 

C 0031 

C J=N I=N t N-liN-2i.,. f l 0032 

C Js=N-l I=N,N-l,N-2t...fl 0033 

C . 0034 

C . 0035 

C J=l I=N,N-1,N-2„..,1 0036 

C 0037 

C LANGUAGE - FORTRAN II SUBROUTINE 0038 

C EQUIPMENT - 709* 7090, 7094 (MAIN FRAME ONLY) 0039 

C STORAGE - 187 REGISTERS 0040 
C SPEED - ABOUT .0000060*N*N*N ♦ .000102*N*N + .000302»N + .000110 0041 

C SECONDS CN THE 7094 MOD I . 0042 

C AUTHOR - R.A. WIGGINS 3/63 0043 

C 0044 

C — * — USAGE 0045 

C 0046 

C TRANSFER VECTOR CONTAINS ROUTINES - DOTJ, STZ 0047 

C AND FORTRAN SYSTEM ROUTINES - SQRT 0048 

C 0049 

C FORTRAN USAGE 0050 

C CALL MFACT (N,AA t BB) 0051 

C 0052 

C INPUTS 0053 

C 0054 
C N IS THE NUMBER OF COLUMNS OR ROWS IN THE MATRICES A AND B. 0055 

C MUST 8i GRTHN= 1 0056 

C 0057 

C AACI) I=1,...,N*N CONTAINS THE MATRIX AU»J) STORED CLOSELY 0058 

C PACKED. 0059 

C 0060 

C OUTPUTS 0061 

C 0062 

C BBU) I = 1,...,N*N CONTAINS THE MATRIX BU,J) STORED CLOSELY 0063 

C PACKED BY COLUMNS. 0064 

C 0065 

C EXAMPLES 0066 

C 006 7 

C 1. INPUTS - N=l AAU) = 4. 0068 

C OUTPUTS - BB(1)=2. 0069 

C 0070 

C 2. INPUTS - N-2 AAU...4) s 5. ,6. ,6. ,9. 0071 

C OUTPUTS - BBC1...4) = l.,0.,2. t 3. 0072 

C 0073 

C 3. INPUTS - N=3 0074 
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C AAU...9) = 4.69,4.74,2.40, 4.74, 6. 13, 3.40, 2.40,I3^%0*4.00 0075 

C OUTPUTS- BB(1...9) * 1.00,0. ,0. ,1.50,1.80,0. , 1.20,li;70*2JOO 0076 

C 0077 

C PROGRAM FOLLOWS BELOW 0078 

C 0079 

DIMENSION AAU0>,BBU0) 0080 

N1=N 0081 

30 NN=N1*N1 0082 

CALL STZ(NN#BB) 0083 

J=NN 0084 

DO 70 1=1, Nl 0085 

11*1-1 0086 

J*J-I1 0087 

J1=J 0088 

JN=J+Nl 0089 

CALL DOTJ (Il,Nl,BB( JN) , Nl , 8B< JN ) , DOT, 0, 1. ) 0090 

BB( J)=SQRTF tAA( J) -DOT) 0091 

J=J-1 0092 

IFUJ 100,100,50 0093 

50 12=1+1 0094 

DO 60 K=I2*N1 0095 

JN1=J+N1 0096 

CALL DOTJ i I1,N1,BB<JN1),N1,BB(JN),D0T,0,1.) 0097 

BB( J)«(AA( J)-D0T)/BB( Jl) 0098 

60 J=J-l 0099 

70 CONTINUE 0100 

100 RETURN 0101 

END 0102 
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• MIFLS (SUBROUTINE) 9/8/64 LAST CARD IN DECK IS NO. 0166 

» LABEL 0001 

CMIFLS 0002 
SUBROUTINE MIFLS < N, LLt BB, RR, GG, FF, C ) 0003 

C 0004 

C ABSTRACT — — 0005 

C 0006 

C TITLE - MIFLS 0007 

C MULTI-INPUT FILTER BY LEAST SQUARES 0008 

C 0009 

C MIFLS INCREASES THE LENGTH OF A MULTI-INPUT LEAST SQUARE 0010 

C FORWARD SHAPER FILTER BY ONE. THAT IS* GIVEN THE VECTOR 0011 

C OF MATRICES F(K,L) (K REFERS TO A PARTICULAR 1 X N MATRIX 0012 

C ELEMENT IN A VECTOR OF L ELEMENTS) THAT SATISFIES THE 0013 

C EQUATIONS 0014 

C 0015 

C F<L,L)*R(0) ♦ ... + FI1,L)*R(L-1) * GfL-ll 0016 

C 0017 

C F(L,L)*R(-1) + ... + Fl 1, L)»R(L-2) * GCL-2JI 0018 

C . 0019 

C . 0020 

C • 0021 

C F(L,L)*R(-L+1)+ ... + FC1,L)*R(0) « GCOi 0022 

C 0023 

C AND BET CO* D AND B(K,L) AS DESCRIBED IN MIPLS 0024 

C THEN MIFLS INCREASES THE LENGTH OF F(K,L) BY ONf SO THAT 0025 

C IT SATISFIES THE EQUATIONS 0026 

C 0027 

C FlL+lt L+1)*R(0) + ... ♦ F( 1,L+1)*R!L) = GCL) 0028 

C ETC. 0029 

C 0030 

C IF R(K) REPRESENTS THE N X N MATRIX VALUED AUTOCORRELATION 0031 

C OF AN N X M MATRIX VALUED WAVELET X<T) 0032 

C 0033 

C RCK) * SUM <X(T+K)*X(T)TRANSPOSE) 0034 

C 0035 

C AND G ( K ) REPRESENTS THE 1 X M MATRIX VALUED CROSS- 0036 

C CORRELATION OF A DESIRED OUTPUT DIT) WITH THE WAVELET X(TJ 0037 

C 0038 

C G IK) * SUM <D(T)*X(T-K)TRANSPOSE) 0039 

C 0040 

C THEN THE FIRST SET OF EQUATIONS ABOVE ARE THE NORMAL 0041 

C EQUATIONS FOR A SHAPER FILTER 0042 

C 0043 

C DC T ) - (F(L,L)*X(T-L) * ... + FC 1*L )»X( T-l ) ) * ZETfTtLI 0044 

C 0045 

C WHERE ZET(T.L) IS AN 1 X M MATRIX VALUED ERROR SERIES. 0046 

C 004 7 

C SEE THE ABSTRACT OF MIPLS FOR THE INTERPRETATION OF 0048 

C B( K, L) AND BETtO,L). 0049 

C 0050 

C LANGUAGE - FORTRAN II SUBROUTINE 0051 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0052 

C STORAGE - 276 REGISTERS 0053 

C SPEED - IF L - 1» THE TIME IS ABOUT 0054 

C 36*N»N ♦ 244*N + 744 MACHINE CYCLESt 0055 

C OR IF L GRTHN 1, THE TIME IS ABOUT 0056 

C 36*N*N*LL + 224*N*LL + 287*LL + 36«N*N - 204#N * 438 U057 

C MACHINE CYCLES ON THE 7090, WHERE LL * L+i . 0058 

C (THESE ESTIMATES ARE BASED ON THE VERSION 0059 

C OF MATML3 WRITTEN MARCH, 1963.) 0060 

C AUTHOR - R.A. WIGGINS 0061 

C 0062 

C USAGE 0063 

C 0064 

C TRANSFER VECTOR CONTAINS ROUTINES - MATML3, MOVREV 0065 

C AND FORTRAN SYSTEM ROUTINES - NONE 0066 

C 0067 

C FORTRAN USAGE 0068 

C CALL MIFLS CN,LL,BB, RR,GG,FF, C) 0069 

C 0070 

C INPUTS 0071 

C 0072 

C N IS THE DIMENSION OF THE MATRICES IN THE F f B, AND R 0073 

C VECTORS. 0074 
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MUST BE GRTHN=1 

LL *LH IS THE NUMBER OF MATRICES IN THE F VECTOR 

AFTER THE PROGRAM HAS OPERATED, 
MUST BE GRTHN= 1 

BBU) I=1,...,LL*N»N CONTAINS THE VECTOR OF 

N X N MATRICES B(0,L) THROUGH B< L ,L ) AS DESCRIBED IN 

THE ABSTRACT. 

IF NN = N»N, THEN 

BBU...N) CONTAINS COLUMN 1 OF B(0,L* 

BB(N*1...2*N) CONTAINS COLUMN 2 OF B(0,L> 

BB< (N+1)*N+1...NN) CONTAINS COLUMN N OF B<Q,L) 
BB(NN+1...(N+1)»N-1) CONTAINS COLUMN 1 OF BU,L) 
ETC. 

RRU) I=1,...,LL»N*N CONTAINS THE AUTOCORREL AT IOfi VECTOR OF 

N X N MATRICES R(O) THROUGH R(L) AS DESCRIBE© IN THE 
ABSTRACT STORED SIMILARLY TO BB(I). 

GGU) I = l,*..i,LL*N*N CONTAINS THE CROSSCORRELAT ION VECTOR OF 

1 X N MATRICES G(O) THROUGH G( L ) AS DESCRIBED IN THE 
ABSTRACT, STORED SIMILARLY TO BB(I). 

FFU) I=*l,*..,(LL-l)*N IS THE FILTER VECTOR OF 1 X N MATRICES 

F(1,L) THROUGH F(L,L) AS DESCRIBED IN THE ABSTRACT, 
STORED SIMILARLY TO BB. 

CU) I=1,a..,6*N*N IS COMPUTATION SPACE NEEDED 8Y MIFLS* 

I*l,..rf,N*N CONTAINS ALPIO,L) AS DESCRIBED IN MIPLS^ 
I=N*N+1...2*N»N CONTAINS BETIO.L) AS OESCRIBED IN MIPLS,! 
I = 2*N*NU,i.. ,3»N*N CONTAINS ALP<0,L) INVERSE 
I=3*N*N+1,*..,4»N*N CONTAINS BET( 0,L) INVERSE 
(THESE VALUES ARE UNDISTURBED BY MIFLS) 

OUTPUTS 
FF( I) 

EXAMPLES 

1. SINGLE-INPUT CASE 

INPUTS - N=l LL=1 BBU...2) » l.,-.4 RR(1...3) * 1.25^.540. 

GGIU..3) = l.,0.,0. CCU.-.4) = U25,1.25,.8,.8 

FFU) - .8 
OUTPUTS - FFU*.«2) = 0.9524,-0.3810 

2. MULT-INPUT CASE - USE OF MIPLS IN CONJUNCTION WITH MIFLS 
INPUTS - N=l L=4 

RRU..-20) = 1.89, 0.89, 0.89, 1.05, GGU . 4 .8 )=*-!. 20,-. 55 



I=1,..^,LL*N CONTAINS THE NEW FILTER F(i,L*l) THROUGH 
F(L+1,L+1) 



1.20, 0.60, 0.55,-0.18, 
0.50, 0.10, 0.50, 0.01, 
•00, .00, .00, .00 

USAGE - LL=0 

DO 10 1=1, L 

CALL MIPLS ( N,LL, AA, BB, RR, C, ERR) 
10 CALL MIFLS ( N,LL , BB, RR, GG, FF, C ) 
OUTPUTS - FFI1..-8) =-0.8564, 0.0288 
0.2117, -0.2008 
0.1531, 0.3455 
-0.3259, 0.1564 

PROGRAM FOLLOWS BELOW 

DIMENSION BB(10),RRU0),GG( 10 ) , FFU 0 ) , C ( 10 ) 

NI=N 

LI=LL-1 

NN=NI»NI 

NN2=NN+1 

NN4=NN2+NN+NN 

NN5=NN4+NN 

LN1=LI«NI+1 



-0.50,-. 50 
.00, .00 
.004 -00 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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LNNl»UNl-l)«NI + l 0150 

20 CALL MOVREVCNI ,1,GGILN1), 1,C < NN5 J U ) 0151 

IF (LI) 90,60,30 0152 

30 CONTINUE 0153 

J=LN1 0154 

DO 50 I=NN2» LNN1 ,NN 0155 

J=J-NI 0156 

CALL MATML3 ( 1 , NI , NI , FF i J ) , RR( I ) , 0. ,Cf NN5) , 1 ) 0157 

50 CONTINUE 0158 

60 CALL MATML3 ( 1 ,N I , NI , C( NN5 ) , C ( NN4 ) , 0. , FF ( LN 1) , 0 ) 0159 

CALL M0VR£V(NI,l,FFtLNl),l,C(NN5),-l.) 0160 

J=LN1 0161 

DO 80 I1-1,LNN1,NN 0162 

CALL MATML3 (1,NI*NI,C( NN5 ),BB( I1),0»,FF(J),I1-1) 0163 

80 J=J-NI 0164 

90 RETURN 0165 

END 0166 



***•«****•»•»*•»*•****#* PROGRAM 
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REFER TO 
MAXSN 
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♦ MINAB * 
••*»#*#•#»«• ««**•*• 

REFER TO 
MAXSN 
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* MINABM * 
**#**»»»***»*»###»♦»**»* 

REFER TO 

MAXSNM 
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REFER TO 

MAXSNM 



•***••**#**•*#*•»«•*«»«» 

• MINSN » 
••«•***»«**»**»*•*•*•«** 

REFER TO 
MAXSN 



#*##***#•*•#**»»*•#***•• 
* MINSN * 
*##♦*♦#*»*#*»*•#*#*♦##»♦ 

REFER TO 
MAXSN 
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»•*««»**#*•**•»****»*•«* 

REFER TO 

MAXSNM 
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REFER TO 

MAXSNM 
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MIPLS (SUBROUTINE) 9/29/64 LAST CARD IN OECK IS NO* 0253 



* LABEL 0001 

CMIPLS 0002 

SUBROUTINE MIPLS C N» LL, AA, BB, RR, C, ERR } 0003 

C 0004 

C —ABSTRACT 0005 

C 0006 

C TITLE - MIPLS 0007 

C MULTI-INPUT PREDICTOR BY LEAST SQUARES 0008 

C 0009 

C MIPLS INCREASES THE LENGTH OF MULTI-INPUT LEAST SQUARE 0010 

C PREDICTION ANO RETROSPECTIVE ERROR OPERATORS BY ONE. 0011 

C THAT IS# GIVEN THE VECTOR OF MATRICES A1K,L3 AND B ( K , L ) 0012 

C (K REFERS TO A PARTICULAR N X N MATRIX ELEMENT IN A 0013 

C VECTOR OF L+l ELEMENTS) THAT SATISFY THE EQUATIONS 0014 

C 0015 

C A(L,L)*R(0) * ... ♦ AC l,L)*R(L-l) ♦ AC0*L)*R<L) * 0 0016 

C 0017 

C AIL,L>»Rt-l) + ... ♦ AC 1,L)*R( L-2) ♦ A* 0#L)»R(L~U* 0 0018 

C . 0019 

C . 0020 

C . 0021 

C ACL, L)*R(-L+1M ... ♦ AC1,L)*R(0) ♦ A(0^L)»RC^1) * 0 0022 

C 0023 

C AND 0024 

C 0025 

C B(0,L)«R<-1) + BU,L)*R(0) ♦ *•* ♦ B(L*L)*RCL-1 )* 0 0026 

C 0027 

C B(0,L)*R(-2) ♦ BU,L)*R(-l) + ... ♦ BCL^L)*RCL~2f * 0 0028 

C . 0029 

C . 0030 

C . 0031 

C BCO,L)*R(-L) + B(l»L)*R(-L+i)+ ... ♦ BCL#L)*R(0t * 0 0032 

C 0033 

C WHERE ACOtL) AND B(0,L) ARE CONSTRAINED TO BE I0BNTITY 0034 

C MATRICES, THEN MIPLS INCREASES THE LENGTHS OF A AND 8 0035 

C BY ONE SO THAT THEY SATISFY THE EQUATIONS 0036 

C 0037 

C A<L+l#L+l)*R(0)+...+AU,L + l)»R<L-l)+ACO,L*l)*R<Lf * 0 0038 

C ETC. 0039 

C AND 0040 

C B(0,L*l)*R(-l)+8<l,L+l)*R<0)+..<.+B<L*l,L + I)*RlL) * 0 0041 

C ETC. 0042 

C 0043 

C IF R(K) REPRESENTS THE AUTOCORRELATION OF AN N X M MATRIX 0044 

C VALUED TIME SERIES X(T) 0045 

C 0046 

C R(K) * EXPECTED VALUE C XC T*K ), XI T ) TRANSPOSE ) 0047 

C 0048 

C THEN THE FIRST SET OF EQUATIONS ABOVE ARE THE NORMAL 0049 

C EQUATIONS FOR THE PREDICTION ERROR OPERATOR 0050 

C 0051 

C A(L,L)»X(T-L) A(1,L)*XIT-1)+AC0,L)*X<T) * EP$|T,L5 0052 

C 0053 

C AND THE SECOND SET OF EQUATIONS ABOVE ARE THE NORMAL 0054 

C EQUATIONS FOR THE RETROSPECTIVE ERROR OPERATOR 0055 

C 0056 

C BCO,L)»X<T)+BC 1,L)*X(T+1) 8( L»L)*X< T+L) * ETA|T,L) 0057 

C 0058 

C WHE*E EPS AND ETA ARE THE N X M MATRIX ERROR SERIES. 0059 

C 0060 

C AS A MATTER OF TERMINOLOGY, WE DEFINE 0061 

C 0062 

C A(L,L>*R(1) A(1,L)»R<L)+A(0,L)»R(L*1) * ALPIL+i,Ll 0063 

C A(L,L)*R(-L)+...+ A(1,L)*RC-1)+AC0,L)»RC0* = ALPCOfrD 0064 

C AND 0065 

C BCO,L)«R(0) ♦ BC1,L)*R(1) B(L,L)»R(L) = BETI 0,L) 0066 

C B€0,L)*R(-L-l)+B( l,L)*RC-L) + ... + B<L,L)«RU) «BETC-L-1 ,L) 0067 

C 0068 

C WHERE ALP(0,L) AND BET ( 0,L ) ARE THE COVARIANCE MATRICES 0069 

C OF EPS(T,L) AND ETA<T,L), RESPECTIVELY. THAT IS 0070 

C 0071 

C ALPi 0#L) » EXPECTED VALUE ( EPSC T ,L ) »EPSC T ,L > TRANSPOSE ) 0072 

C BETC 0*L ) = EXPECTED VALUE < ETAC T, L ) »ET AC T|LI TRANSPOSE ) 0073 

C 0074 



PROGRAM LISTINGS 



• MIPLS 
(PAGE 2) 



***#*•*•»**»«*»**•**••»• 

# MIPLS » 
**•*••**•»••«#•*«•#»••** 

(PAGE 2) 



MIPLS RETURNS THE VALUES OF ALP(OtL) AND BET( 0» L ) FOR 
THE NEW OPERATORS OF LENGTH L + l. 

LANGUAGE - FORTRAN II SUBROUTINE 
EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY } 



STORAGE 
SPEED 



AUTHOR 



- 571 REGISTERS 

- IF LL=0 ABOUT 33*N*N*N ♦ 148«N*N * 163»N ♦ 1287 
MACHINE CYCLES ON THE 7090. 

IF LL=1 ABOUT 156*N«N*N + 769*N«N + 369»N ♦ 2369 

MACHINE CYCLES ON THE 7090. 
IF LL GRTHN 1 ABOUT ( 36*LL+120) «N»N*N ♦ ( 2l6*fcL*S63l*N*N 
♦ (28«LL+368)«N ♦ 396*LL ♦ 1990 MACHINE CYCLES 
ON THE 7090. 

- R.A. WIGGINS 

——USAGE 

TRANSFER VECTOR CONTAINS ROUTINES - IXCARG,MATINV,MATML3,MATRA< 

MD0T3,M0VREV,STZ 
AND FORTRAN SYSTEM ROUTINES - NONE 

FORTRAN USAGE 

CALL MIPLS (N,L£,AA, BB,RR,C,ERR) 



INPUTS 
N 



LL 



AA(I) 



BBU) 
RR( I) 
C(I) 

OUTPUTS 
LL 

AA(I) 
BBU) 
CU) 

ERR 



IS THE DIMENSION OF THE MATRICES IN THE At B, AND R 

VECTORS. 
MUST BE GRTHN= 1 

»L+1 THE NUMBER OF MATRICES IN THE A AND B VECTORS 

WHEN THE PROGRAM IS ENTERED (THIS IS ALSO AN OUTPUT). 
MUST BE GRTHN=0 

I*1,...,LL*N*N CONTAINS THE VECTOR OF MATRICES A(0»LI 
THROUGH A( Lf L ) AS DESCRIBED IN THE ABSTRACT. 
IF NN » N*N THEN 
AA(l«*..N) CONTAINS COLUMN I OF MATRIX A(0|L) 

AA(N*1...2N) CONTAINS COLUMN 2 OF MATRIX At 0* L) 



AA( (N-l )*N+1...NN) CONTAINS COLUMN N OF MATRIX A(OR) 
AA(NN+1...NN+N-1) CONTAINS COLUMN 1 OF MATRIX AfllL) 
ETC. 

1 = 1,*.. ,LL*N»N CONTAINS THE VECTOR OF MATRICES BIO,L) 
THROUGH B(LtL) AS DESCRIBED IN THE ABSTRACT, STORED 
SIMILARLY TO AA( I). 

I=l,...,<LL+l)»N*N CONTAINS THE CORRELATION VECTOR OF 
MATRICES R<0) THROUGH R( L+ 1 ) AS DESCRIBED IN THE 
ABSTRACT, STORED SIMILARLY TO AA(I). 

I=1,...,5»N*N+N IS COMPUTATION SPACE NEEDED BY MIPLS* 
I=1,..*,N*N CONTAINS ALP(0,L) 

I=N*N+1...2*N*N CONTAINS BET(0,L) 
I=2*N*N+1...3*N*N CONTAINS ALP( 0, L ) INVERSE 
I=3*N*N+1.*.4*N*N CONTAINS BET < 0, L ) INVERSE 



=1*2 INCREASED ONE FROM ITS INPUT VALUE. 

I«1,..«,LL»N»N (NEW LL) CONTAINS A(0,L«-l) THROUGH 
A(L+1,L+1). 

I=1,...,LL*N»N (NEW LL) CONTAINS BfO v L*l) THROUGH 
B(L+l,L+l). 

I = i,..«;,N*N CONTAINS ALP(0,L+1) 

I=N*N+1...2»N*N CONTAINS BET(0,L+1) 

I=2*N»N+l...3«N*N CONTAINS ALP( 0,L+1 ) INVERSE 

I = 3»N*N4-1...4»N»N CONTAINS BETf 0,L + 1 ) INVERSE 

=0. IF SOLUTION WAS SUCCESSFUL. 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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C *1. IF ANY MATRICES THAT HERE INVERTED WERE SINGULAR, 0150 

C =2. IF OVERFLOW OR UNDERFLOW OCCURRED DURING INVERSION. 0151 

C =3. IF THE VALUE OF L IS ILLEGAL 0152 

C 0153 

C EXAMPLES 0154 

C 0155 

C 1. SINGLE-INPUT EXAMPLE 0156 

C INPUTS - N=l LL=0 RRU...3) = 1.25, .50,0. 0157 

C OUTPUTS - AAU)~1. BB(1)=1. C(U;.4) * 1.25, 1.25*. 8, .8 ERR*0. 0158 

C LL*1 0159 

C 0160 

C 2. CONTINUATION OF ITERATION FROM EXAMPLE I. 0161 

C INPUTS - SAME AS OUTPUTS FOR EXAMPLE 1. 0162 

C OUTPUTS - AACU..2) * l.,-.4 BB(U.,2) = i.,-*4 LL*2 fRR*0. 0163 

C CU...4) = 1.05,1.05,0.9524,0.9524 0164 

C 0165 

C 3. MULTI-INPUT EXAMPLE 0166 

C INPUTS - N=l L*5 LL=0 0167 

C RRC1...24) = 1.89, 0.89, 0.89, 1.05, 0168 

C 1.20, 0.60, 0.55,-0.18, 0169 

C 0.50, 0.10, 0.50, 0.01, 0170 

C 0. ,0.,0.,0.,0.,0.,0.,0.,0.,0.!0.,@* 0171 

C USAGE - DO 10 1=1, L 0172 

C 10 CALL MIPLS C N ,LL , AA, 88, RR,C, ERR ) 0173 

C OUTPUTS - AA(K..20) « 1.0000, 0. , 0. , 1.0000, 0174 

C -0.8564,-0.5639, 0.0288, 0*1852, 0175 

C 0.2117, 0.6365,-0.2008,-0.4866, 0176 

C 0.1531, 0.2426, 0.3455,-0.6331, *0177 

C -0.3259, 0.2593, 0.1564,-0.7539 0178 

C BBI1...20) = 1.0000, 0. ,0. , I. 0000, 0179 

C -0.7383,-0.2250,-0.1260, 0.0671, 0180 

C 0.0209,-0*2111, 0.1523,-0.3603, 0181 

C 0.4137, 0.7391,-0.1588,-0.8445, 0182 

C -0.2272, 0.3056,-0.0745,-0.8026 0183 

C C (1...16) = 0.8837, 0.3902, 0.3902, 0.7371, 0184 

C 0.9542, 0.5186, 0.5186, 0.8050, 0185 

C 1.4768,-0.7816,-0.7816, 1.7703, 0186 

C 1.6128,-1.0390,-1.0390, 1.9116 0187 

C LL = 5 ERR » 0. 0188 

C 0189 

C PROGRAM FOLLOWS BELOW 0190 

C 0191 

DIMENSION AAU0),BBI10),RR(10),C(10},CM(10) 0192 

COMMON CM 0193 

NI^N 0194 

LI -LL 0195 

NN=NI»NI 0196 

NN2=NN+1 0197 

CALL IXCARG <C,IC1) 0198 

IC2=IC1+NN 0199 

IC3=IC2+NN 0200 

IC4=IC3+NN 0201 

IC45=IC4+NN 0202 

IC5*IC45+NI 0203 

LNN1=LI*NN+1 0204 

LNNO=LNNl— NN 0205 

CALL IXCARG (AAtLNNl ) , IAD 0206 

CALL IXCARG ( BBlLNNl ) , I8L) 0207 

IF (LI) 10^20,40 0208 

C ILLEGAL LL. 0209 

10 ERR=3. 0210 

15 RETURN 0211 

C SPECIAL CASE LL*0 0212 

20 CALL STZ ( NN, AA> 0213 

CALL STZ (NN,BB) 0214 

N1=NI+1 0215 

DO 30 I=i,NN,Nl 0216 

AA(I)=1. 0217 

30 BB(I)*1. 0218 

CALL MOVREV ( NN# 1 , RR , 1 , CMUC1 ) , 1 ) 0219 

CALL MOVREV (NN,1,RR,1,CM< IC2), 1) 0220 

CALL MATINV ( N I , CM ( IC1 ) , CM( IC3) ,CM( IC4 ) , ERR ) 0221 

CALL MOVREV (NN# 1 , CM ( IC3 ) , 1 ,CM( IC4 ) , 1 ) 0222 

LL=1 0223 

GO TO 15 0224 
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C GENERAL CASE. LL GRTHN 1. 




0225 


C 








0226 


C CONSTRUCT ACL+UL+l) 




0227 


40 


CALL M00T3 


(NI,NI,NI,LI, AA, RR(NN2),0.,CM( IC5),-1.) 


0228 




CALL MATML31NI 9 KiI»NI«CM< IC5 ) , CM ( IC4 ) , 0. ,CM( I AL ) , 


0) 


0229 




CALL M0VREV(NN,1,CMUAL) tl*CM< IAL),-1. ) 




0230 


C CONSTRUCT B(L+1 


♦ L+l) 




0231 




CALL MATRA 


CCM( IC5),N,N,CM( IC4) ) 




0232 




CALL MATML3(NI,NI,NI,CM( IC4) f CM( IC3) ,0.,CM( IBL), 


0) 


0233 




CALL M0VREV(NN,1,CM{ IBL) , 1 , CMC I BL 1 ,-1 . ) 




0234 




if (Li-n 


10,75,60 




0235 


C FILL IN OTHER TERMS OF A AND B. 




0236 


60 


CONTINUE 






0237 




J=LNN0 






0238 




DO 70 I2=NN2,LNN0,NN 




0239 




CALL MOVREV 


(NN*1,AA(J),1,CM( IC3), 1.) 




0240 




CALL MATML3 


(NI,NI ,NI,CM( IAL),88( I2),0.,AA( J),l) 




0241 




CALL MATML3 


(NI*NI,NI,CMUBL),CM< IC3 ) , 0 . , BB ( 12 ) , 


n 


0242 


70 


J=J-NN 






0243 


C GET 


NEW ALP AND 


BET 




0244 


75 


CONTINUE 






0245 




CALL MATML3 


(NI»NI, NI,CM( IAL),CMI IC4),0.,CM( IC1) 


• i) 


0246 




CALL MATINV 


(NI»CM(IC1) ,CM( IC3),CM( IC4),EKR1) 




0247 




CALL MATML3 


(NI,NI,NI,CM( I8L),CMUC5),0.,CM( IC2) 


ti) 


0248 




CALL MATINV 


(NI,CM(IC2),CM( IC4),CM( IC45),ERR2) 




0249 




ERR«ERR1+ERR2 




0250 




LL«LI*1 






0251 




GO TO 15 






0252 




END 






0253 



•»•»+•*••**••••»*«•**•«• PROGRAM LISTINGS «#•**»**»#*#»#*»******** 

» HISS « * MISS * 



*«««•****•*»*«••••**••*• 



CMISS 0002 

SUBROUTINE MISS <N»U AA t BB,RR,GG,FF,C) 0003 

C 0004 

C —ABSTRACT — — 0005 

C 0006 

C TITLE - MISS 0007 

C MULTI-INPUT SIDEWARDS ITERATION 0008 

C 0009 

C MISS PERFORMS A SIDEWARDS ITERATION OF A MULTI-INPUT 0010 

C MATRIX VALUED FILTER F(K,L) ^CK REFERS TO THE K-TH 1 X N 0011 

C MATRIX ELEMENT IN A VECTOR OF L ELEMENTS) TO CORRESPOND 0012 

C TO A SIMILAR ITERATION OF A CROSSCORRELAT ION VECTOR G(K) • 0013 

C THAT I S* GIVEN A VECTOR FCK»L) THAT SATISFIES 0014 

C 0015 

C FIL,L)»R(0) + ... + FC 1,L)*R(L-1) ^ G(L-l) 0016 

C 0017 

C FtL,LJ*R(-l) + ... + FC It L)»R( L-2 ) = G(L-2) 0018 

C . 0019 

C . 0020 

C . 0021 

C FtL#L>«R(~L+l)+ ... ♦ F(i,L)*R(0) * G(0* 0022 

C 0023 

C AND THE ERROR OPERATORS A(K,L-1) AND B(K,L-t) WITH THEIR 0024 

C RESPECTIVE COVARIANCE MATRICES ALP(0,L-1) AND BfTfO,L-l) 0025 

C THAT CORRESPOND TO THE R(T) ABOVE (SEE ABSTRACT Of? 0026 

C MIPLS FSR A DESCRIPTION OF THESE QUANTITIES! 0027 

C THEN MISS COMPUTES THE VECTOR OF MATRICES F1(K,L) 0028 

C WHICH SATISFY 0029 

C 0030 

C Fl(Ltt)*R(0) ♦ ... + FU1,L)*R(L~1) * GU-21 0031 

C . 0032 

C . 0033 

C . 0034 

C FULtL)*R(-L+l)+ ... + F1(UL)*R(0) = G(-1S 0035 

C 0036 

C SEE THE ABSTRACT OF MIFLS FOR A DESCRIPTION OF R€T)4 G(T1 0037 

C 0038 

C LANGUAGE - FORTRAN II SUBROUTINE 0039 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0040 

C STORAGE - 335 REGISTERS 0041 

C SPEED - ABOUT (54*L-18 ) *N»N «• (346«L~91)»N ♦ 411»L ♦ 522 0042 

C MACHINE CYCLES ON THE 7090. 0043 

C AUTHOR - R. A. WIGGINS 3/63 0044 

C 0045 

C — « USAGE 0046 

C 0047 

C TRANSFER VECTOR CONTAINS ROUTINES - MATML3, MD0T3,MOVREV 0048 

C AND FORTRAN SYSTEM ROUTINES - NONE 0049 

C 0050 

C FORTRAN USAGE 0051 

C CALL MISS tN#L#AAf BBfRRf GG»FF t C) 0052 

C 0053 

C INPUTS 0054 

C 0055 

C N IS THE DIMENSION OF THE MATRICES IN THE A, B, R» G» F, 0056 

C AND Fl VECTORS. 0057 

C MUST BE GRTHN=1 0058 

C 0059 

C L IS THE NUMBER OF MATRICES IN THE A, B, R, F, AND Fl 0060 

C VECTORS. 0061 

C MUST BE GRTHN=1 0062 

C 0063 

C AAU) I = l,i..*,L*N*N CONTAINS THE N X N MATRIX VALUED PREDICTION 0064 

C ERROR OPERATOR A(OtL-l) THROUGH A(L-l»L-l) AS COMPUTED 0065 

C BY MIPLS. 0066 

C 0067 

C BB(I) 1=1 t» • - f L*N*N CONTAINS THE N X N MATRIX VALUED 0068 

C RETROSPECTIVE ERROR OPERATOR B(0,L-1) THROUGH 0069 

C 8(L-ItL-l) AS COMPUTED BY MIPLS. 0070 

C 0071 

C RRU) I»l f k.JtL»N«N CONTAINS THE N X N MATRIX VALUED 0072 

C AUTOCORRELATION VECTOR R(0) THROUGH RID STORED CLOSELY 0073 



•••*•*•«*•**•#***»***«»• PROGRAM 
» MISS * 
•*••»*#*•*•**•*•*«*»»•#* 

(PAGE 2) 



LI STINGS **««***»••***•«*•*•»#**• 
» MISS • 
#*##*#***#**•#«*•**•»••* 

(PAGE 2) 



C PACKED BY COLUMNS. 0074 

C 0075 

C GGII) I=l,...,(L+i)*N CONTAINS THE 1 X N MATRIX VALUED 0076 

C CRCSSCORRELATION VECTOR G(-l) THROUGH G(L-l) AS 0077 

C DESCRIBED IN THE ABSTRACT. 0078 

C 0079 

C FFU) I=i,...,L*N CONTAINS THE 1 X N MATRIX VALUED SHAPER 0080 

C FILTER F(1,L) THROUGH FtL,L> AS COMPUTED BY MIFLS. 0081 

C 0082 

C CU) 1 = 1,... ,6*N*N IS COMPUTATION SPACE NEEDED BY M*S5«i 0083 

C I=i,...,N»N CONTAINS THE COVARIANCE MATRIX ALPlO^t) 0084 

C AS COMPUTED BY MIPLS. 0085 

C I=N*N+l, ... ,2*N*N CONTAINS THE COVARIANCE MATRIX BETIO^Ll 0086 

C AS COMPUTED BY MIPLS. 0087 

C 0088 

C OUTPUTS 0089 

C 0090 

C FFU) I=1,*..,L*N»N CONTAINS THE 1 X N MATRIX VALUED SHAPER 0091 

C FILTER FK1,L) THROUGH F1(L,L) AS DESCRIBED *N THE 0092 

C ABSTRACT. 0093 

C 0094 

C EXAMPLES 0095 

C 0096 

C 1. INPUTS - L=2 N*l RRU...2) « 1.25, .5 GG< U..2) » 0.,1. 0097 

C IG1=2 IG2=1 0098 

C USAGE - LL=0 0099 

C DO 10 1 = 1, L 0100 

C CALL MIPLS (N,LL,AA,BB,RR,C, ERR ) 0101 

C 10 CALL MIFLS < N,LL , BB, RR, GG< IG1 ) , FF,C ) 0102 

C CALL MISS (N,L,AA,BB,RR,GG< IG2),FF,C) 0103 

C OUTPUTS - ERR=0. 0104 

C FF(U.*2> = -0.3810,0.9524 0105 

C 0106 



C 2. INPUTS - L=2 N*2 RRU...8) = 1. 25, 0. , 0. , 1. 16, 0. 5, 0. .., 0. , 0. 4 0107 



C GGC1...4) = l.,0.,0.,0. IGi = 3 IG2=1 0108 

C USAGE - SAME AS EXAMPLE 1. 0109 

C OUTPUTS - ERR=0. 0110 

C FFM...4) * 0.9524,0.0,-0.3810,0.0 0111 

C 0112 

C 3. INPUTS - L=2 N*2 RRU...8) * 1.89,0.89,0.89,1.05, 0113 

C 1*20,0.60,0.55,-0.18 0114 

C GG(l..i4) = -1.2,-0.55,-0.5,-0.5 IG1=3 IG2=1 0115 

C USAGE - SAME AS EXAMPLE I. 0116 

C OUTPUTS - ERR=0. 0117 

C FFCU.M) = -0.5050,-0.6413,0.6842,-0.9015 0118 

C 0119 

C PROGRAM FOLLOWS BELOW 0120 

C 0121 

DIMENSION AA(2),BB(2),RR(2) ,GG(2),FF( 2),C(2) 0122 

NI=N 0123 

LI=L 0124 

NN=NI*NI 0125 

NN2=NN+1 0126 

NN3-NN2+NN 0127 

NN5=NN3+NN*NN 0128 

NN6=NN5+NI 0129 

LA8=LI*NN 0130 

IF1=LI«NI-NI+1 0131 

CALL M0VREV(NI,l,FF(IFl),l,FFUF13,-l.) 0132 

J=IF1-NI 0133 

DO 10 I=NN2,LAB,NN 0134 

CALL MATML31 l,NI,NI ,FF( IFl),BB( I),0.,FF(J), 1) 0135 

10 J=J-NI 0136 

CALL MD0T3 €1 ,N I, NI , LI-1 , FF , RR< NN2 ) ,- 1. ,C ( NN5 ), 1. ) 0137 

CALL MOVREV( IF1-1, 1,FF, l,FF(NI+l), 1.) 0138 

J=NN5 0139 

DO 20 1=1, NI 0140 

C(J) = GGU)-C(J> 0141 

20 J = J+1 0142 

CALL MATML3( 1,NI,NI,C( NN5 ) ,C( NN3) ,0. ,C( NN6 ) , 0) 0143 

J*i 0144 

DO 30 1*1, LAB, NN 0145 

CALL MATML3 ( 1 , NI , NI ,C( NN6) ,AA(I),0.,FF(J), 1-1) 0146 

30 J=J+NI 0147 

RETURN 0148 

END 0149 
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* MLI2A6 (SUBROUTINE) 9/29/64 LAST CARD IN OfCK IS NO, 0217 

* FAP 0001 
•MLI2A6 0002 

COUNT 200 0003 

LBL MLI2A6 0004 

ENTRY MLI2A6 ( MLI , ML I HOL, NCRS ) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 
» TITLE - MLI2A6 0009 

* CONVERT MACHINE LANGUAGE INTEGER TO EQUIVALENT HOLLERITH 0010 
» 0011 
» MLI2A6 CONVERTS A MACHINE LANGUAGE INTEGER (CONSIDERED 0012 

* DECIMAL) INTO A 2-REGISTER FORTRAN VECTOR OF EQUIVALENT 0013 

* HOLLERITH ( FORMAT( 2A6) ) WITH LEADING ZEROES SUPPRESSED! 0014 
» PLUS SIGN SUPPRESSED, SIGNIFICANT DIGITS RIGHT ADJUSTED, 0015 

* AND MINUS SIGN <IF PRESENT) RIGHT ADJUSTED AGAINST MOST 0016 

* SIGNIFICANT DIGIT. 0017 
» 0018 

* LANGUAGE - FAP SUBROUTINE {FORTRAN II COMPATIBLE) 0019 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0020 
» STORAGE - 128 REGISTERS 0021 
» SPEED - 0022 

* AUTHOR - S.M. SIMPSON JR., JUNE 1962 0023 

* 0024 

* -—USAGE 0025 

* 0026 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0027 

* AND FORTRAN SYSTEM ROUTINES - NONE 0028 

* 0029 

* FORTRAN USAGE 0030 
» CALL MLI2A6(MLI*MLIH0L,NCRS) 0031 

* 0032 

* INPUTS 0033 
» 0034 

* MLI IS THE MACHINE LANGUAGE INTEGER* 0035 

* 0036 
» OUTPUTS 0037 

* 0038 

* ML I HOL IS THE HOLLERITH EQUIVALENT OF ML I IN 2A6 FORMATJ 0039 

* * 0040 

* NCRS IS THE NO, OF NON-BLANK CHARACTERS INVOLVED (INCLUDING 0041 

* THE MINUS SIGN IF PRESENT). 0042 

* 0043 

* EXAMPLES 0044 

* 0045 

* 1. INPUTS - ML I = OCT 173 (^DECIMAL 123) 0046 
» OUTPUTS - MLIHCL(1,2) * OCT 606060606060,606060010203 NGR5*3 0047 

* 0048 

* 2. INPUTS - ML I * OCT 400000000173 (^DECIMAL -123) 0049 

* OUTPUTS - MLIH0LC1,2)» OCT 606060606060,606040010203 NCRS*4 0050 

* 0051 
» 3. INPUTS - ML I » OCT 144 (= DECIMAL 100) 0052 
» OUTPUTS - MLIH0L(1,2)= OCT 606060606060,606060010000 NCRS*3 0053 
» 0054 

* 4. INPUTS - MLI « OCT 0 ( +0) 0055 
« OUTPUTS - ML IHGLil, 2 ) = OCT 606060606060,606060606000 NGRS*1 0056 

* 0057 

* 5. INPUTS - MLI » OCT 400000000000 (= -0) 0058 
» OUTPUTS - MLIH0L(il,2) » OCT 606060606060,606060604000 NCRS*2 0059 

* 0060 
» 6. INPUTS - MLI * OCT 400000000144 (^DECIMAL -100) 0061 

* OUTPUTS - MLIH0L(1,21 = OCT 606060606060,606040010000 N€RS*4 0062 

* 0063 

* 7. INPUTS - MLI * OCT 777777777777 (^DECIMAL -34359738367) 0064 
» OUTPUTS - MLIH0L(1,2) » OCT 400304030511,070310030607 NCRS*12 0065 
» 0066 

HTR 0 0067 

BCI 1,MLI2A6 0068 

MLI2A6 SXA EXIT,1 0069 

SXA EXIT+H2 0070 

SXA EXIT+2#4 0071 

SXD MLI2A6-2,4 0072 

CLA 1,4 0073 

STA GET! 0074 
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CLA 2,4 0075 

STA PUT2A 0076 

SUB Kl 0077 

STA PUT2B 0078 

CLA 3,4 0079 

STA PUT3 0080 

» STORE MAGN(MLI) AND SET FOR SIGN. 0081 

GET! CLA ** A ( ML I ) 0082 

TMI NEG 0083 

STO ML I 0084 

STZ NCRS 0085 

CLA SPACE 0086 

STOSN STO SIGN 0087 

TRA CNVRT 0088 

NEG SSP 0089 

STO ML I 0090 

CLA Kl 0091 

STO NCRS 0092 

CLA MINUS 0093 

TRA STOSN 0094 

* NOW CONVERT THE MAGNITUDE INTO TWELVE REGISTERS. 0095 

* XR1 IS THE DIGIT INDEX *ll,10,...,l 0096 

• XR2 IS THE DIGIT 0,1,.. .9 0097 

♦ XR4 IS A LEADING ZERO SUPPRESS INDICATOR 0098 
» XR4 * 1 MEANS CONVERT DIGIT*0 TO SPACE 0099 

• * 0 MEANS DONT SUPPRESS A ZERO DIGIT. 0100 
CNVRT LXA Kl*4 0101 

CLA SPACE 0102 

STA H0LV1-5 0103 

CLA ML I 0104 

STO TEMP 0105 

LXA Kll,l 0106 

GTEMP CLA TEMP 0107 

LXA K0,2 0108 

» (NOTE - ZEROES ARE PLUS ZEROES IN SUBTRACTIONS BELOW) 0109 

SUB SUB POWRS+1,1 0110 

TMI ADD 0111 

TXI SUB, 2,1 0112 

« (NOTE - ZEROES WILL BE MINUS ZERO IN ADDITION BELOW, BUT NO HARM^I 0113 

ADD ADD POWRS+1,1 0114 

STO TEMP 0115 

* AT THIS POINT XR2 CONTAINS DESIRED DIGIT. 0116 
» STORE DIGIT IE CSUPPRESS IS OFF) OR CSUPPRESS IS ON AND THIS IS DIGIT 0117 

• 1). 0118 

TXL PXA,4,0 0119 

TXL STNDGS«1,1 0120 

• OTHERWISE SUPPRESS DIGIT IF ZERO 0121 

PXA 0,2 0122 

TZE GTSPA 0123 

• IF GETS HERE, THIS IS FIRST DIGIT}. TURN OFF SUPPRESS, SET NDIGSl 0124 
» SET NDIGS, SET SIGN CHARACTER, AND STORE DIGIT. 0125 

LXA K0,4 0126 

STNDGS SXA NDIGS, I 0127 

CLA SIGN 0128 

STA H0LV2,l 0129 

TRA PXA 0130 

» THIS SETS SPACE IN PLACE OF LEADING ZERO. 0131 

GTSPA CLA SPACE 0132 

TRA STA 0133 

PXA PXA 0,2 0134 

STA STA H0LV2+l,l 0135 

TIX GTEMP, 1,1 0136 

• STORE NCRS. 0137 

CLA NDIGS 0138 

ADD NCRS 0139 

STO NCRS 0140 

* NOW FORM ML I HI AND MLIH2 BY 0141 

* PACKING UP H0LV1 AND H0LV2 RESPECTIVELY. 0142 

STZ MLIH1 0143 

STZ MLIH2 0144 

CLA K30 0145 

STO LSHIFT 0146 

LXA K6*l 0147 

STSHFT CLA LSHIFT 0148 

STA LGL1 0149 
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STA 


LGL2 




0150 




CAL 


HOLVl+itl 




0151 


LGL1 


LGL 


*• 




0152 




ORA 


ML I HI 




0153 




SLW 


ML I HI 




0154 




CAL 


H0LV2+1,1 




0155 


LGL2 


LGL 


** 




0156 




ORA 


MLIH2 




0157 




SLW 


MLIH2 




0158 




CLA 


LSHIFT 




0159 




SUB 


K6 




0160 




STO 


LSHIFT 




0161 




TIX 


STSHFTAtl 




0162 




TRA 


LEAVE 




0163 


» LEAVE, STORING RESULTS 




0164 


LEAVE 


CLA 


NCRS 




0165 




ALS 


18 




0166 


PUT3 


STO 


*• 


A(NCRS) 


0167 




CLA 


ML I Hi 




0168 


PUT2A 


STO 


*• 


A ( ML I HOL ( 1 ) ) 


0169 




CLA 


MLIH2 




0170 


PUT2B 


STO 


*• 


A(MLIH0L(2I> 


0171 


EXIT 


AXT 


#*, 1 




0172 




AXT 


*»,2 




0173 




AXT 


♦♦,4 




0174 




TRA 


4,4 




0175 


* CONSTANTS 






0176 




DEC 


ioeoooooooo 




0177 




DEC 


1OOOO0OO0O 




0178 




DEC 


100000000 




0179 




DEC 


10000000 




0180 




DEC 


1000000 




0181 




DEC 


100000 




0182 




DEC 


10000 




0183 




DEC 


1000 




0184 




DEC 


100 




0185 




DEC 


10 




0186 


POWRS 


DEC 


1 




0187 


SPACE 


OCT 


60 




0188 


MINUS 


OCT 


40 




0189 


KO 


PZE 


0 




0190 


Kl 


PZE 


1 




0191 


K6 


PZE 


6 




0192 


KIO 


PZE 


10 




0193 


Kll 


PZE 


11 




0194 


K30 


PZE 


30 




0195 


» TEMPORARIES 






0196 


ML I 


PZE 


** 


MAGNITUDE OF ML I 


0197 


SIGN 


PZE 


•* 


* OCT 60 OR OCT 40 


0198 




PZE 


♦* 


SPACE OR MINUS 


0199 




PZE 


*• 


0,1*2,.. .,9 OR SPACE OR MINUS 


0200 




PZE 


• » 


ETC 


0201 




PZE 


•* 


ETC 


0202 




PZE 


*» 


ETC 


0203 


HOLV1 


PZE 


** 


ETC 


0204 




PZE 


»* 


ETC 


0205 




PZE 


** 


ETC 


0206 




PZE 


*• 


ETC 


0207 




PZE 


** 


ETC 


0208 




PZE 


• * 


ETC 


0209 


HOLV2 


PZE 


** 


0,1,2,.. .,9 (NOT SPACE OR MINUS) 


0210 


MLIH1 


PZE 


»* 


COMPLETED HOL FOR MLIHOL(I) 


0211 


MLIH2 


PZE 


»* 


COMPLETED HOL FOR MLIH0L(2) 


0212 


NOIGS 


PZE 


•* 




0213 


NCRS 


PZE 


• * 




0214 


LSHIFT 


PZE 


** 


30, 24, 0 


0215 


TEMP 


PZE 
END 


»» 




0216 
0217 
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MLISCL * • MLISCL * 

»*••••*«»*»••••*»»*• *•#«•• ft* «•**«#• »••»••»•• 



MLISCL (SUBROUTINE) 
FAP 



•MLISCL 



COUNT 100 
LBL MLISCL 

ENTRY MLISCL (MLIV, LMLIV, I SCALE, ML IVSC, IANS) 

* 

* — - — ABSTRACT 

• 

» TITLE - MLISCL 

* MULTIPLY AN ML I VECTOR BY A FORTRAN FIXEO POINT INTEGER 
• 

» MLISCL MULTIPLIES EACH ELEMENT OF AN ML I VECTOR BY A 

* GIVEN FORTRAN FIXED POINT INTEGER, CHECKING FOR OVERFLOW* 
# 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 
« STORAGE - 47 REGISTERS 

* SPEED - LENGTH OF VECTOR TIMES 25 MACHINE CYCLES 

* AUTHOR - S.M. SIMPSON JR, JUNE 1962 
• 

» — USAGE 

* 

» TRANSFER VECTOR CONTAINS ROUTINES - NONE 

* AND FORTRAN SYSTEM ROUTINES - NONE 
* 

» FORTRAN USAGE 

» CALL MLISCL(MLI¥,LMLIV,ISCALE,MLIVSC,IANS) 

* 

* INPUTS 
* 

* MLIV(I) 

» LMLIV 
* 

* I SCALE 
» 

» OUTPUTS 

* MLIVSCU) 
» 

« IANS 



« EXAMPLES 



• 1. INPUTS 
» OUTPUTS 



* 2. INPUTS 



■ 0 MEANS JOB DONE OK 
=-l MEANS ILLEGAL LMLIV 
—2 MEANS OVERFLOW OCCURRED. 



MLIV* OCT 1,2,3 LMLIV=3 ISCALE=4 
IANS*0 MLIVSC* OCT 4,10,14 

SAME AS EXAMPLE 1 EXCEPT LMLIV*- 2 



9/29/64 LAST CARD IN DECK IS NO. 0114 

0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 



1*1.. .LMLIV IS THE ML I VECTOR 
MUST EXCEED 0 

IS THE FORTRAN FIXED POINT MULTIPLIER. 



1 = 1.. .LMLIV *ISCALE»MLIVU... LMLIV) AS A ML I VECTOR* 
< NOTE MLIVSC MAY BE EQUIVALENT TO MLIVK 



» OUTPUTS 


- I ANS=-1 




0052 


• 






0053 


» 3. INPUTS 


- SAME AS EXAMPLE 1. EXCEPT MLIV(l)* OCT 3777777T7777 


0054 


• OUTPUTS 


* IANS=-2 




0055 


• 






0056 


• 4. INPUTS 


- MLIVIU* 


0CT2 LMLIV*1 ISCALE*5 


0057 


« OUTPUTS 


- MLIVSCIU) 


* 0CT12 IANS=0 


0058 


• 






0059 


HTR 


0 




0060 


BCI 


1, MLISCL 




0061 


MLISCL SXA 


EXIT,1 




0062 


SXD 


MLISCL-2, 


4 


0063 


CLA 


1,4 


A(A(MLIV) ) 


0064 


ADD 


Kl 




0065 


STA 


LDQ 




0066 


CLA 


2,4 


A ( A( LMLIV ) ) 


0067 


STA 


GET2 




0068 


CLA 


3,4 


A( A( ISCALE) ) 


0069 


STA 


GET3 




0070 


CLA 


4,4 


A(A(MLIVSO) 


0071 


ADD 


Kl 




0072 


STA 


STQ 




0073 


CLA 


5,4 


A(AUANS)) 


0074 
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STA 




PUT5 




0075 


* GET LMLIV 


1 1 SCALE 9 AND 


CHECK LMLIV. 


0076 


CLS 




Kl 




0077 


STO 




IANS 




0078 


GET2 CLA 




** 


A( LMLIV) 


0079 


ARS 




18 




0080 


STO 




LMLIV 




0081 


TMI 




LEAVE 




0082 


TZE 




LEAVE 




0083 


GET3 CLA 




•* 


A( ISCALE) 


0084 


ARS 




18 




0085 


STO 




ISCALE 




0086 


* SET IANS 


FOR 


POSSIBLE 


OVERFLOW DURING LOOP. 


0087 


CLS 




K2 




0088 


STO 




IANS 




0089 


* LOOP , CHECKING FOR OVERFLOW. 


0090 


LXA 




LMLIV* 1 




0091 


LOQ LDQ 




• ♦,1 


A(MLIVm 


0092 


MPY 




ISCALE 




0093 


STQ STQ 




***1 


A(MLIVSCm 


0094 


TNZ 




LEAVE 




0095 


TIX 




LDQ, 1,1 




0096 


• ALL OK IF 


FALLS THRU 1 


LOOP. 


0097 


CLA 




KO 




0098 


STO 




IANS 




0099 


* SET IANS 


AND 


EXIT. 




0100 


LEAVE CLA 




IANS 




0101 


ALS 




18 




0102 


PUT5 STO 




*♦ 


A( IANS) 


0103 


EXIT AXT 




*«, 1 




0104 


TRA 




6,4 




0105 


* CONSTANTS 








0106 


KO PZE 




0 




0107 


Kl PZE 




1 




0108 


K2 PZE 




2 




0109 


» VARIABLES 








0110 


LMLIV PZE 




»# 




0111 


I SCALE PZE 




*» 




0112 


IANS PZE 




•* 


-1,-2,0 


0113 


END 








0114 
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MONOCK » • MONOCK 



« MONOCK ( SUBROUTINE ) 9/4/64 LAST CARD IN DECK IS NO, 0164 

* FAP 0001 
•MONOCK 0002 

COUNT 100 0003 

L8L MONOCK 0004 

ENTRY MONOCK (X, LXt ZFNOCRt IANSNGt IANS) 0005 

• 0006 

• 0007 

« ABSTRACT 0008 

« 0009 

» TITLE - MONOCK 0010 

• CHECK VECTOR FOR MONOTONE INCREASING OR DECREASING BEHAVIOR 0011 
» 0012 

• MONOCK CHECKS EITHER THAT A GIVEN VECTOR IS MONOTONE 0013 
« INCREASING ( NON-DECREASING ) OR THAT IT IS MONOTONE 0014 
« DECREASING (NON-INCREASING). MINIMUM VECTOR LENGTH IS 0015 
« 2 . VECTOR MAY BE FIXEO OR FLOATING POINT » AND MONOCK 0016 

* FORCES THE SIGN BIT POSITIVE FOR ALL VECTOR ELEMENTS OF 0017 

• ZERO MAGNITUDE. 0018 

• 0019 
« LANGUAGE - FAP SUBROUTINE ( FORTRAN-I I COMPATIBLE) 0020 
« EQUIPMENT - 709,7090t7094 (MAIN FRAME ONLY) 0021 
« STORAGE - 48 REGISTERS 0022 
« SPEED - (709,7090) 50+8*LX MACHINE CYCLES, LX = VECTOR LENGTH 0023 

• AUTHOR - S.M. SIMPSON, JUNE 1964 0024 
» 0025 

* 0026 

* USAGE 0027 

* 0028 
« TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0029 

• AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0030 
« 0031 

• FORTRAN USAGE 0032 
» CALL MONOCMX, LX, ZFNDCR, IANSNG, IANS ) 0033 

• 0034 
« 0035 
» INPUTS 0036 

* 0037 

• X(I) I = 1...LX IS THE VECTOR, MAY BE FIXED OR FLOATING. 0038 
» 0039 

• LX SHOULD EXCEED 1 . 0040 
« 0041 
« ZFNDCR = 0 REQUESTS A CHECK FOR NON-DECREASING BEHAVIOUR. 0042 

• NOT= 0 REQUESTS A CHECK FOR NON-INCREASING BEHAVIOUR. 0043 

* 0044 

• IANSNG IS THE DESIRED IANS OUTPUT IF THE CHECK FAILS. 0045 

♦ 0046 

* 0047 
« OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LX LSTHN* 0 . 0048 

• 0049 

* X(I) OUTPUT WILL EQUAL XII) INPUT EXCEPT THAT THE SIGN BIT 0050 
» OF ALL ZERO MAGNITUDE VALUES, IF ANY, WILL BE POSITIVE 0051 
» ON OUTPUT. THIS WILL BE TRUE REGARDLESS OF THE 0052 

• OUTCOME OF THE TEST. 0053 
« 0054 

• IANS * 0 IF LX * 1, OR IF X(I) PASSES THE TEST. 0055 

* = IANSNG IF X(I) FAILS THE TEST. 0056 
« 0057 
« 0058 

* EXAMPLES 0059 
« 0060 

* 1. INPUTS - IXK1...5) * 1,2,2,3,4 1X2(1. ..5) * 1,2,1,3,4 0061 
« IANS7 * 43 XK1...5) = 4. , 3. ,2. ,2 . , 1 . 0062 

* X2U...5) « 4.,3.,1.,2.,1. 0063 
» USAGES - CALL MONOCK( I XI , 5, 0. ,-1 , 1 ANSI ) 0064 

* CALL MONOCK ( 1X2,5,0. ,-2, IANS2) 0065 
« CALL MONOCM XI , 5, 1 . ,-3, IANS3 ) 0066 

• CALL MONOCM X2, 5, 1. ,-4, IANS4) 0067 

* CALL MONOCM 1X2,2,0. ,-5, IANS5) 0068 

* CALL MONOCM 1X2,1,0. ,-6, IANS6) 0069 

* CALL MONOCM 1X2,0,0. ,-7, IANS7) 0070 

♦ OUTPUTS - IANS1,IANS2,...,IANS7 = 0,-2,0,-4,0,0,43 0071 

* 0072 
» 2. INPUTS - 1X3(1. ..3) = 1X4(1. ..3) * +0,-0, +0 0073 

* 1X5(1. ..3) = 1X6(1. ..3) = -0,+0,-0 0074 
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* 


1X7(1. ..3) 




-0,+0,-l 1X8(1. ..3) * +0,-0, +1 






0075 


ft 


1X9 = IXIO 


ss 


-0 






0076 




CALL 


M0N0CKUX3, 3,0., -8.IANS8) 






0077 


ft 


CALL 


MONOCK! 1X4, 3,1., -9,IANS9) 






0078 


ft 


CALL 


M0N0CK(IX5, 3,0.,-10,IANS10) 






0079 


ft 


CALL 


M0N0CK(IX6, 3,l.,-ll,IANSll) 






0080 


* 


CALL 


M0N0CK(IX7, 3,0.,-12,IANSl2) 






0081 


« 


CALL 


MONOCK( 1X8, 3,1.,-13,IANS13) 






0082 


• 


CALL 


M0N0CK(IX9, 1,0.,-14,IANS14) 






0083 


• 


CALL 


MONOCK( IX10,1,1.,-15,IANS15) 






0084 


* OUTPUTS 


- IANS8...IANS15 » 0,0,0,0,-12,-13,0,0 






0085 


• 


1X3(1. ..3) 


s 


1X4(1. ..3) » 1X5(1. ..3) * 1X6(1... 


3) 




0086 


« 


* +0 




i y -fO 






0087 


« 


1X7(1. ..3) 




♦0»+0»-l 1X8(1. ..3) * +0 t +0,4-l 






0088 


« 


1X9 * 1X10 




+ 0 






0089 


• 












0090 


• 












0091 


« PROGRAM FOLLOWS BELOW 










0092 


ft 












0093 




: VECTOR 










0094 














0095 


HTR 


0 




XR4 






0096 


BCI 


1, MONOCK 










0097 


ft 












0098 


* ONLY ENTRY* 


MONOCKfX, LX, 


ZFNDCR, IANSNG, IANS) 






0099 


• 












0100 


MONOCK SXO 


MONOCK-2,4 










0101 


CLA 


It 4 




A(X) 






0102 


STA 


CAS1 










0103 


STA 


CAS2 










0104 


ADD 


Kl 




A(X)+1 






0105 


STA 


CLA1 










0106 


STA 


CLA2 










0107 


STA 


CLA3 










0 108 


CLA* 


4,4 




IANSNG 






0109 


STO 


IANSNG 




BROUGHT IN 






0110 


LDQ* 


3,4 




ZFNDCR IN MQ FOR A WHILE 






0111 














0112 


w unci/ ^ uui 


LX AND, IF OK, 


SET IT IN XR4. THEN SET X(LX) 




+0 IF 


0113 


♦ IT IS 7FRO 


MAGNITUDE. 1 


EXIT IF LX « 1, OTHERWISE BRANCH 


TO 


LOOP. 


0114 














0115 


CLA* 


2,4 




LX 






0116 


TMI 


TRA 




(NO ACTION 






0117 


TZE 


TRA 




EXITS) 






0118 


PDX 


0,4 










0119 


CLA1 CLA 


**,4 




** a A(X)+1, GIVES X(LX) 






0120 


TNZ 


*+2 










0121 


STZ* 


CLA1 










0122 


PXD 


0,0 










0123 


XCA 






ZFNDCR IN AC, +0 IN MQ 






0124 


TXI 


*+l,4,-l 




LX-l IN XR4 






0125 


TXL 


LEAVE, 4,0 










0126 


TNZ 


CLA3 










0127 


« 












0128 


* INCREASING 


CASE • COMPARE 


X(J) IN AC AGAINST XU+1) J » 


LX- 


-It ...» i 


0129 


• 


( AND FORCE 


ZEROES POSITIVE) 






0130 


« 












0131 


CLA2 CLA 


**,4 




** * A(X)+1 






0132 


TNZ 


CAS1 










0133 


SSP 












01 34 


STO* 


CLA2 










0135 


CAS1 CAS 


»*,4 




** « A(X) 






0136 


LDQ 


IANSNG 




NG 






0137 


TIX 


CLA2,4,1 




OK 






0138 


TIX 


CLA2,4,1 




OK 






0139 


TRA 


LEAVE 










0140 


« 












0141 


« DECREASING 


CASE. SAME COMPARISON SEQUENCE. 






0142 


• 












0143 


CLA3 CLA 


**,4 




** = A(X)*1 






0144 


TNZ 


CAS2 










0145 


SSP 












0146 


STO* 


CLA3 










0147 


CAS2 CAS 


**,4 




** * A(X) 






0148 


TIX 


CLA3,4,1 




OK 






0149 
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TRA TIX OK 0150 

LDQ I ANSNG NG 0151 

TIX TIX CLA3,4,1 0152 

* 0153 

* EXIT SETTING IANS FROM HQ* 0154 
« 0155 

LEAVE LXO MONOCK-2,4 0156 

STQ» 5,4 0157 

TRA TRA 6,4 0158 

* 0159 

* CONSTANTS, TEMPORARIES 0160 

* 0161 
Kl PZE 1 0162 

I ANSNG PZE »»,»»,»• 0163 

END 0164 



* MOUT * 

• •••*••••**•«»•***«-»***• 



PROGRAM LISTINGS 



**«*«****«***#*••**#••»» 
* MOUT # 
4 •**»*******«#• *•****•*» 



* MOUT ISUBROUTINE) 9/8/64 LAST CARD IN DECK IS NO, 0100 

* LABEL 0001 
CMOUT 0002 

SUBROUTINE MOUT i I T APE , NSPACE, X, XNAME, NRX, NCX,LX ) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - MOUT 0007 

C MATRIX OUTPUT IN G FORMAT 0008 

C 0009 

C MOUT WRITES A VECTOR OF MATRICES ON AN OUTPUT TAPE* THE 0010 

C MATRICES ARE ASSUMED TO BE STORED TIGHTLY PACKfD BY 0011 

C COLUMNS, THE MATRIX IS HEADED BY A LINE SUCH AS 0012 

C 0013 

C MATRIX ( 1... 3, 1... 5, 1... 2 ) * 0014 

C 0015 

C AND THEN EACH SUCCEEDING ROW IS PRINTED IN F0RMATC5G15.71 0016 

C WITH OCUBLE SPACES BETWEEN ROWS AND TRIPLE SPACES BETWEEN 0017 

C MATRICES. 0018 

C 0019 

C LANGUAGE - FORTRAN II SUBROUTINE 0020 

C EQUIPMENT - 709 OR 7090 CMAIN FRAME AND TAPE UNIT) 0021 

C STORAGE - 130 REGISTERS 0022 

C SPEED - 0023 

C AUTHOR - R.A. WIGGINS 3/64 0024 

C 0025 

C 0026 

C USAGE 0027 

C 0028 

C TRANSFER VECTOR CONTAINS ROUTINES - CAR IGE 0029 

C AND FORTRAN SYSTEM ROUTINES - <FIL),<STH) 0030 

C 0031 

C FORTRAN USAGE 0032 

C CALL MOUT f I T APE, NSPACE ,X , XNAME, NRX , NCX , LX ) 0033 

C 0034 

C 0035 

C INPUTS 0036 

C 0037 

C ITAPE LOGICAL TAPE NUMBER FOR OUTPUT 0038 

C 0039 

C NSPACE NUMBER OF SPACES FOR CARRIAGE TO BE MOVED BEFORE PRINTING 0040 

C IF LSTHN 0, THE PAGE IS RESTORED. 0041 

C 0042 

C XU) 1=1. ..NRX, l...NCX,l...LX IS THE VECTOR OF MATRICES TO BE 0043 

C WRITTEN. THE COLUMNS, AND MATRICES, MUST BE CLOSELY 0044 

C SPACED. 0045 

C NEED NOT BE FLOATING POINT. 0046 

C 0047 

C XNAME IS A 6, OR FEWER, CHARACTER HOLLERITH NAME FOR THE ARRAYS 0048 

C 0049 

C NRX NUMBER OF ROWS IN EACH X MATRIX. 0050 

C MUST BE GRTHN- 1 0051 

C 0052 

C NCX NUMBER OF COLUMNS IN EACH X MATRIX. 0053 

C MUST 81 GRTHN- 1 0054 

C 0055 

C LX NUMBER OF MATRICES IN X. 0056 

C MUST BE GRTHN^ 1 0057 

C 0058 

C NOTE - THE LEGALITY OF ITAPE, NRX, NCX, AND LX IS NOT CHECKED. 0059 

C 0060 

C 0061 

C OUTPUTS - ARRAY IS WRITTEN ON TAPE ITAPE. 0062 

C 0063 

C 0064 

C EXAMPLES 0065 

C 0066 

C 1. INPUTS - ITAPE * 2 NSPACE = 1 XNAME * 1HX 0067 

C X( 1...2,1...2, 1...2) = 1., 2., 3., 4. ,6,7,8,9 0068 

C NRX =2 NCX a 2 LX = 2 0069 

C OUTPUTS - THE FOLLOWING LINES ARE WRITTEN ON LOGICAL TAPE 2 . 0070 

C X { 1... 2, 1... 2, 1... 2 t * 0071 

C 0072 

C 1.0000000 3.0000000 0073 

C 0074 
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C 2,0000000 4.0000000 0075 

C 0076 

C 0077 

C 6 8 0078 

C 0079 

C 7 9 0080 

C 0081 

C PROGRAM FOLLOWS BELOW 0082 

C 0083 

DIMENSION XC2) 0084 

CALL CARIGE ( I TAPE,NSPACE) 0085 

WRITE OUTPUT TAPE ITAPE, 10,XNAME,NRX,NCX,LX 0086 

10 FORMAT <3XA6^7H I l.;.I5,7H, l..iI5,7H, l».iI5,5H * * I 0087 

LXM=NRX*NCX 0088 

LXT*LXW»LX 0089 

DO 40 I1=ULXT,LXM 0090 

J1*I1+NRX-1 0091 

J2*Il+LXM-l 0092 

DO 30 12=11, Jl 0093 

WRITE OUTPUT TAPE ITAPE, 20, <X( I),I~I2,J2,NRX) 0094 

20 F0RMAT</(5X5G15.7H 0095 

30 CONTINUE 0096 

CALL CARIGE UTAPE,1) 0097 

40 CONTINUE 0098 

RETURN 0099 

END 0100 
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• MOUTAI * ♦ MOUTAI * 
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» MOUTAI {SUBROUTINE) 9/4/64 LAST CARO III DECK IS NO. 0294 

» LABEL 0001 

CMOUTAI 0002 
SUBROUTINE MOUTAI i I TAPE t NS PACE* EOF I J,FNAME,L I ,L J, IDIMEN, 0003 
1 NDIGS, SCALE, SPACE) 0004 

C 0005 

C 0006 

C —ABSTRACT 0007 

C 0008 

C TITLE - MOUTAI 0009 

C OUTPUT A MATRIX AS INTEGERS DENSELY PACKED OFF-LINE 0010 

C 0011 

C MOUTAI IS DESIGNED FOR TIGHTLY PACKED PRINTED 0UTPUT 0012 

C OF RELATIVELY LOW ACCURACY MATRIX DATA. MOUTAI FINOS OR 0013 

C IS GIVEN A SUITABLE SCALE FACTOR TO CONVERT A FLOATING 0014 

C POINT MATRIX TO FIXED POINT DATA WITH A SPECIFIED MAXIMUM 0015 

C NO* (1 TO 5) OF DIGITS. THESE ARE THEN PRINTED IN FORMAT 0016 

C OF 6012, OR 4013, OR 3014, OR 2515, OR 2016 RESPECTIVELY* 0017 

C 0018 

C VARIOUS SCALING OPTIONS EXIST, BUT THE ORIGINAL MATRIX 0019 

C ALWAYS REMAINS UNDISTURBED SINCE THE SCALING IS DONE ROW 0020 

C BY ROW INTO A SCRATCH VECTOR PROVIDED BY THE USERw 0021 

C 0022 

C LANGUAGE - FORTRAN II SUBROUTINE 0023 

C EQUIPMENT - 709 OR 7090 < MAIN FRAME PLUS 1 TAPE DRIVE) 0024 

C STORAGE - 357 REGISTERS 0025 

C SPEED - A MATRIX F OF DIMENSION FC50*20) TAKES ABOUT 0026 

C .48 SECONDS (ON THE 7094) IF MOUTAI DOES THI SCALING! 0027 

C ABOUT .42 SECONDS IF F IS ALREADY FIXED POINT* 0028 

C AUTHOR - S.M. SIMPSON, MARCH 1964 0029 

C 0030 

C 0031 

C * USAGE 0032 

C 0033 

C TRANSFER VECTOR CONTAINS ROUTINES - CAR IGE ♦ GNH0L2»MAXABM, RND, MOVE i 0034 

C MULPLY,F IXVR, SAME 0035 

C AND FORTRAN SYSTEM ROUTINES - 6XPI2, (FID , LOG, I STH) 0036 

C 0037 

C FORTRAN USAGE 0038 

C CALL MOUTAI ( I TAPE , NSPACE, FOFIJ, FNAME, LI, LJ, IDIMEN, 0039 

C I NDIGSISCALE, SPACE) 0040 

C 0041 

C 0042 

C INPUTS 0043 

C 0044 

C ITAPE IS LOGICAL TAPE NO. FOR OUTPUT 0045 

C SHOULD LIE BETWEEN 1 AND 20 (NOT CHECKED) 0046 

C 0047 

C NSPACE IS DESIRED NO. OF INITIAL BLANK LINES BEFORE OWTPUT 0048 

C BEGINS. MAY BE ZERO. IF LESS THAN ZERO A 0049 

C PAGE RESTORE IS CREATED. 0050 

C 0051 

C FOFIJU,J) 1 = 1. J.LI, J=L..LJ IS THE LI BY LJ MATRIX TO 0052 

C BE PRINTED. FOFIJ IS FLOATING POINT EXCEPT IN THE 0053 

C CASE SCALE * 0.0 AS DESCRIBED BELOW. 0054 

C 0055 

C FNAME IS 6 HOLLERITH ( FORMAT, UA6) ) TO BE USED AS A LABEL FOR 0056 

C FOFIJ. 0057 

C 0058 

C LI SHOULD EXCEED ZERO (NOT CHECKED) 0059 

C 0060 

C LJ SHOULD EXCEED ZERO (NOT CHECKED) 0061 

C 0062 

C IDIMEN IS THE VALUE TO WHICH THE INDEX I IN FOFIJ (I, J) IS 0063 

C DIMENSIONED IN THE CALLING PROGRAM 0064 

C 0065 

C NDIGS SPECIFIES THE MAXIMUM NUMBER OF DIGITS (EXCLUSIVE OF 0066 

C SIGN* WHICH MAY BE USED TO EXPRESS THE SCALED VALUES OF 0067 

C THE MATRIX. NDIGS MAY ONLY HAVE VALUES = 1,2<*3#4* OR 5. 0068 

C THE FIELD WIDTH IN PRINTING WILL BE ONE GREATER THAN 0069 

C NDIGS. 0070 

C 0071 

C SCALE SPECIALIZES THE TYPE OF SCALING TO BE PERFORMED. 0072 

C FOR SCALE=0.0, IT IS ASSUMED THAT FOFIJ IS ALREADY 0073 

C IN INTEGER FORM (COMPATIBLE WITH NDIGS). IN THIS CASE 0074 
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C MOUTAI DOES NO SCALING. 0075 

C 0076 

C IF SCALE EXCEEOS O.O t IT IS ASSUMED THAT SCALE IS A 0077 

C SCALE FACTOR THE CALLING PROGRAM WISHES MOUTAI TO USE 0078 

C AS FOLLOWS, 0079 

C OUTPUT INTEGER » ( SCALE * FOFIJ) ROUNDED TO INTEGERS 0080 

C 0081 

C IF SCALE=-1., MOUTAI FINDS ITS OWN SCALE FACTOR^ THE 0082 

C FACTOR RESTRICTED TO BEING A POWER OF 10, ? SUCH THAT 0083 

C THE LARGEST OUTPUT MAGNITUDE, CALL IT MAXMAG# WILL 0084 

C SATISFY 10EXPINDIGS-1) LSTHN* MAXMAG LSTHN 0085 

C iOEXP(NDIGS). 0086 

C 0087 

C IF S€ALE=-2., MOUTAI FINDS ITS OWN SCALE SUCH THAT THE 0088 

C LARGEST OUTPUT MAGNITUDE, MAXMAG, WILL =10EXi(NDf GS-l! a 0089 

C 0090 

C SPACE U) I*l«*.LI*l MUST BE AVAILABLE FOR SCRATCH 0091 

C 0092 

C 0093 

C 0094 

C OUTPUTS THE ONLY OUTPUT WILL BE ON LOGICAL ITAPE. VALUES ALONG 0095 

C ROWS ON THE PRINTED PAGE WILL CORRESPOND TO INCREASING 0096 

C VALUES GF THE INDEX I IN FOFIJCI,J). SEE EXAMPLES 0097 

C BELOW FOR GENERAL FORMAT. 0098 

C 0099 

C 0100 

C EXAMPLES 0101 

C 0102 
C 1. INPUTS - F0FIJ(1.;.9,1...2) * 1 1 „ , 2 1 . » . . . , 91 . , , -12.S-22. U I 4 *-92* 0103 

C IF0FIJ11...75) * 1,2, ...,75 0104 

C 0105 

C USAGE - DIMENSION FOF I J( 15, 2) , IFOF IJ { 75, 1 ) , SPACE* 76) 0106 

C DO 10 NDIGS=1,2 0107 

C CALL M0UTAI(2,2,F0FIJ t 6HF0FIJl,9,2,15,ND*GS*fcli 0108 

C 1 SPACE) 0109 

C CALL M0UTAI(2,2,.F0FIJ,6HF0FIJ2,9,2,15,NDIGSiE~l«O 0110 

C 1 SPACE) 0111 

C CALL M0UTAI(2,2*FQFIJ,6HF0FIJ3,9,2,l5,NDiG$,-24* 0112 

C 1 SPACE) 0113 

C 10 CALL M0UTAI(2,2,IF0FIJ,6HIF0FIJ,75,U75,NDIG$40., 0114 

C 1 SPACE) 0115 

C 0116 

C OUTPUTS - 64 OUTPUT LINES ARE CREATED ON LOGICAL 2 J COLUMNS 2 0117 

C THRU 51 ARE SHOWN BELOW (COLUMN 1 IS ALWAYS BLANK} . 0118 

C 0119 

C 0120 

C FOFIJi(I,J) * 0.10000E 00 AND ROUNDED 0121 

C 0122 

C J 1=1.*. 9 0123 

C 0124 

C 1/123456789 0125 

C 2/- 1-2-3-4-5-6-7-8-9 0126 

C 0127 

C 0128 

C F0FIJ2(I,J) * 0.10000E 00 ANO ROUNDED 0129 

C 0130 

C J I . » 1 .<#. 9 0131 

C 0132 

C 1/123456789 0133 

C 2/- 1-2-3-4-5-6-7-8-9 0134 

C 0135 

C 0136 

C F0FIJ3(I,J) * 0.10870E-01 AND ROUNDED 0137 

C 0138 

C J I = 1 9 0139 

C 0140 

C 1/000011111 0141 

C 2/-0-0-0-0-1-1-1-1-1 0142 

C 0143 

C 0144 

C IFOFIJUtJ) 0145 

C 0146 

C J I = 1 75 0147 

C 0148 

C 1/12345678 910111213141516171819202122 0149 
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C 616263646566676869707172737475 0150 

C 0151 

C 0152 

C FQFIJ1(I,J) * 0.10000E 00 AND ROUNDED 0153 

C 0154 

J 1*1 .J. 9 0155 

C 0156 

C 1/ 123456789 0157 

C 2/ -1-2 -3 -4 -5 -6 -7 -8 -9 0158 

C 0159 

C 0160 

C F0FIJ2(I,J) » O.iOOOOE 01 AND ROUNDED 0161 

C 0162 

C J I = 1 -J. 9 0163 

C 0164 

C 1/ 11 21 31 41 51 61 71 81 91 0165 

C 2/-12-22-32-42-52-62-72-82-92 0166 

C 0167 

C 0168 

C FGFIJ3U,J> » 0.10870E 00 AND ROUNDED 0169 

C 0170 

C J 1=1.-*. 9 0171 

C 0172 

C 1/ 12345789 10 0173 

C 2/ -1 -2 -3 -4 -5 -7 -8 -9-10 0174 

C 0175 

C 0176 

C IFOFI«Mt,J) 0177 

C 0178 

C J 1=1 .J* 75 0179 

C 0180 

C 1/ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 1 0181 

C 41 42 43 44 45 46 47 48 49 50 51 52 53 54 5 0182 

C 0183 

C 0184 

C 0185 

C PROGRAM FOLLOWS BELOW 0186 

C 0187 

C 0188 

C DUMMY DIMENSIONS 0189 

C 0190 

DIMENSION F0FIJC2),SPACE<2) 0191 

C 0192 

C TRUE DIMENSIONS 0193 

C 0194 

DIMENSION FMTC5J,NW<4) 0195 

C 0196 

C BRING IN SOME INPUTS, DO INITIAL CARIAGE SPACING 0197 

C 0198 

ITP « ITAPE 0199 

LX = LI 0200 

LY = LJ 0201 

IDIM * IDIMEN 0202 

NOGS « NDIGS 0203 

SCA « SCALE 0204 

8IGEST a 10J0«*NDGS 0205 

LSP » LX+1 0206 

CALL CARIGEUTP^NSPACE) 0207 

C 0208 

C THE NO. WORDS PER ROW t NW(NDGS), IS 0209 

C NW(i.*.5) » 60, 40, 30, 25, 20 0210 

C 0211 

NW * 5M9-NDGS) 0212 

IF (NDGS-2) 35,30,40 0213 

30 NW = 40 0214 

GO TO 40 0215 

35 NW = 60 0216 

C 0217 

C CONSTRUCT THE FORMAT FMTU...5) FOR OUTPUTING ROWS 0218 

C 0219 

40 NWC2) - NDGS+1 0220 

IF (NW-LX) 50,45,50 0221 

45 NW«NW+1 0222 

50 NW(3)=NWm 0223 

NW(4)=NW<2) 0224 
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CALL GNHOL2 ( NW *4, 41H(9H( IX 14, IH/ 12, IH 1 1 1, 4H/I 6X 12, 1HII1,2H) 1 ) , 
1 FMT, IDUMrflDUM, IDUM) 

C 

C NOW WE HAVE TO SET THE SCALE FACTOR SCL 

C (ANTICIPATE FOR THE CASE SCALE GRTHN* 0.) 

C 

SCL * SCA 

IF (SCA) 100,200,200 

C 

C FOR THE NEGATIVE CASE WE ARE GOING TO NEED THE RESULT FROM 
C MAXABM REGARDLESS* TEST THE RESULT FOR ZERO, THEN BRANCH 
C ON SCALE * -U OR -2. (ANTICIPATING A -2.) 
C 

100 CALL MAXABMIF0F1J, LX,LY, IDIM,FMAXAB,TEMP, TEMP) 

SCL * 0.0 

X » ABSF (FMAXAB) 

IF (X) 120,200,120 
120 SCL = .1»BIGEST/X 

IF (SCA+1.0) 200,150,200 

C 

C SET SCALING FOR THE CASE SCALE = -1.0 
C 

C THIS IS ALMOST THE SAME AS THE FOLLOWING PROBLEM 

C GIVEN X GRTHN Oi N ■ INTEGER GRTHN 38 0, 

C FIND M = PCS* OR NEG. INTEGER SUCH THAT 

C 10EXPIN) LSTHN= X«10EXP(M) LSTHN 10EXPIN+1), 

C WHOSE SOLUTION IS 

C M = N - (LOGUHTRUNCATED ♦ EPS 

C WHERE EPS » 0 IF X GRTHN^O, « 1 IF X LSTHN 0. 

C 

C OUR CASE IS SLIGHTLY DIFFERENT DUE TO A TERMINAL ROUNDING 
C OF X*10EXPIM), WHICH MAY ROUND IT UP INTO 10EXPIN+1). 
C 

C IN OUR CASE N * NDIGS-1, X = ABSF ( FMAXAB) 
C 

150 M * NDGS-1-XFIXF(.43429448«L0GF(X) ) 

IF (X-1.0) 160,170,170 
160 M * M+l 
170 SCL » 10.0*«M 

IF ( RNDF ( SCfe*X )-*B IGEST ) 200,180,180 
180 SCL * SCL/1G.0 

C 

C PROCEED WITH THE HEADING OUTPUT 
C 

200 IF (SCL) 215,205,215 

205 WRITE OUTPUT TAPE ITP,210,FNAME,LX 

210 FORMAT(1X,A6,5H(I,J),//,4X,1HJ,30X,10HI * 1 ... ,l4r/,lH 3 

GO TO 700 

215 WRITE OUTPUT TAPE ITP,220,FNAME,SCL,LX 
220 FORMAT (1X,A6,8HII,J) » ,E13.5,12H AND ROUNDED,//, 
1 4X,1HJ,30X,10*I » 1 ... ,I4,/,1H ) 

C 

C OUTPUT THE ROWS ONE BY ONE, FIRST MOVING THEM INTO SPACE( 2. «ULX*|| 



WITH SCALING AND CONVERSION IF NECESSARY 



700 



DO 770 IXR0W=1,LY 
SPACE II) * SAMEF(IXROW) 
IXF * U(IXROW-l)»IDIM 
IF (SCL) 740,730,740 
730 CALL M0VE(LX,FCFU(IXF),SPACE(2)) 
GO TO 760 

740 CALL MULPLYtFOFIJI IXF ) ,LX,SCL,SPACE( 2) ) 

CALL FIXVR(SPACE(2),LX,SPACE(2)) 
760 WRITE OUTPUT TAPE ITP,FMT, < SPACE! I ) , 1=1, LSP ) 
770 CONTINUE 

C 

C EXIT 
C 

9999 RETURN 
END 



0225 
0226 
0227 
0228 
0229 
0230 
0231 
0232 
0233 
0234 
0235 
0236 
0237 
0238 
0239 
0240 
0241 
0242 
0243 
0244 
0245 
0246 
0247 
0248 
0249 
0250 
0251 
0252 
0253 
0254 
0255 
0256 
0257 
0258 
0259 
0260 
0261 
0262 
0263 
0264 
0265 
0266 
0267 
0268 
0269 
0270 
0271 
0272 
0273 
0274 
0275 
0276 
0277 
0278 
0279 
0280 
0281 
0282 
0283 
0284 
0285 
0286 
0287 
0288 
0289 
0290 
0291 
0292 
0293 
0294 
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* MOVE (SUBROUTINE) 9/29/64 LAST CARD IH DECK IS NO. 0091 

* FAP 0001 
•MOVE 0002 

COUNT 75 0003 

LBL MOVE 0004 

ENTRY MOVE ( N» SOURCE, DEST ) 0005 

» 0006 

» — — ABSTRACT- 0007 

» 0008 

» TITLE - MOVE 0009 

« MOVE A VECTOR TO A DIFFERENT LOCATION 0010 

* 0011 

* MOVE MOVES A VECTOR TO A DIFFERENT LOCATION* OVERLAP 0012 

* OF THE SOURCE AND DESTINATION VECTORS IS ALLOWED. 0013 
» 0014 
» LANGUAGE -* FAP* SUBROUTINE I FORTRAN II COMPATIBLE) 0015 

* EQUIPMENT - 709, 7090, 7094 (MAIN FRAME ONLY) 0016 

* STORAGE - 32 REGISTERS 0017 

* SPEED - ABOUT 8»N + 34 MACHINE CYCLES ON THE 7094 WHERE N IS 0018 
» THE LENGTH OF THE VECTOR. 0019 
» AUTHOR - J.F. CLAERBOUT, JUNE, 1962 0020 
» 0021 

» — USAGE ~ 0022 

» 0023 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0024 

* AND FORTRAN SYSTEM ROUTINES - NONE 0025 
» 0026 
» FORTRAN USAGE 0027 

* CALL MOVE (N, SOURCE, DEST) 0028 

* 0029 

* INPUTS 0030 

* 0031 
» SOURCEU) 1 = 1. . .N IS A VECTOR OF WORDS. 0032 

* (NEED NOT HAVE FLOATING NAME ) 0033 

* 0034 

* N IS FORTRAN II INTEGER. 0035 
» MUST BE GRTHN=0. 0036 
» OUTPUTS 0037 

* 0038 
» DEST(I) 1=1. *.N IS THE SOURCE VECTOR. 0039 

* (NEED NOT HAVE FLOATING NAME) 0040 

* 0041 
» EXAMPLES 0042 

* 0043 

* LET SGWRCEII),I=1...K BE EQUIVALENT TO DEST( J ) ,U«1*J*K 0044 
» 1. INPUTS - SOURCEU. ..3) = l.,2.,3* N=3 1*1 J = 5 0045 
» OUTPUTS - DEST(5a..7) = l.,2.,3. 0046 

* 0047 
» 2, INPUTS - SAME AS EXAMPLE 1. EXCEPT J*2 0048 

* OUTPUTS - DEST(2...4) = l.,2.,3. 0049 

* 0050 

* 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT J=l 0051 

* OUTPUTS - DESTU...3) = l.,2.,3. 0052 

* 005 3 

* 4. INPUTS - S0URCEC3...5) = l.,2.,3. N=3 1=3 J=l 0054 

* OUTPUTS - 0ESTIU..3) = l.,2.,3. 0055 
» 0056 
« 5k, INPUTS - S0URCEC1...33 = l.,2.,3* N=0 1*1 J=5 0057 

* OUTPUTS - DESTC54..7) IS UNCHANGED. 0058 

* 0059 
HTR 0 0060 
BCI I, MOVE 0061 

MOVE SXD *-2,4 0062 

N2T* 1,4 0063 

TRA 4,4 0064 

CLA 2,4 0065 

ADD =1 0066 

STA SPA 0067 

STA SPB 0068 

CLA 3,4 0069 

ADD =1 0070 

STA DPA 0071 

STA DPB 0072 

CLA 2,4 DECIDE WHICH ONE OF THE TWO MOVING 0073 

SUB 3,4 LOOPS IS BEST ( IN CASE OF OVERLAP! 0074 
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TMI 


PB 


DEST IS IN HIGHER MEMORY LOC 


0075 




CLA* 


1,4 


SOURCE IS IN HIGHER MEMORY LOC 


0076 




PDX 


,4 




0077 


SPA 


CLA 


♦ •♦4 




0078 


DPA 


STO 


***4 




0079 




TIX 


*-2,4,i 




0080 




TRA 


SV4 




0081 


PB 


CLA« 


1,4 




0082 




STD 


PBL 




0083 




AXT 


1.4 




0084 


SPB 


CLA 


** , 4 




0085 


OPB 


STO 


• ♦,4 




0086 




TXI 


•+1,4, I 




0087 


PBL 


TXL 


SPB,4,#* 




0088 


SV4 


LXD 


MOVE-2^4 




0089 




TRA 


4,4 




0090 




END 






0091 
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• MOVECS (SUBROUTINE) 9/29/64 LAST CAftO IN DECK IS NO* 0105 

• FAP OOOi 
•MOVECS 0002 

COUNT 150 0003 

LBL MOVECS 0004 

ENTRY MOVECS (LXY1.X1 ,Y1, . .. ,LXYN,XN,YN) 0005 

• 0006 

• ABSTRACT — — 0007 

« 0008 

• TITLE - MOVECS 0009 

• MOVE AN ARBITRARY SET OF VECTORS 0010 
» 0011 

• MOVECS IS A VARIABLE-LENGTH-CALLING-SEQUENCE SUBROUTINE. 0012 

• THE ARGUMENTS ARE CONSIDERED IN TRIPLETS* EACH TRIPLET 0013 
» SPECIFYING THE MOVING OF ONE VECTOR (LENGTH, SOURCE, 0014 

• DESTINATION) • THE OUTPUT VECTORS MAY OVERLAP THE SOURCE 0015 
» VECTORS IN ANY MANNER. 0016 
» 0017 

• LANGUAGE - FAP SUBROUTINE (FORTRAN-II COMPATIBLE) 0018 

• EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0019 
» STORAGE - 24 REGISTERS 0020 
» SPEED - 5 + 28#N + 8»M MACHINE CYCLES, WHERE N = NO. VECTORS 0021 
« MOVED, AND M » THEIR COMBINED LENGTH. 0022 
» AUTHOR - S.M. SIMPSON, AUGUST 1963 0023 

• 0024 

• USAGE— — 0025 

• 0026 

• TRANSFER VECTOR CONTAINS ROUTINES - MOVE 0027 

• AND FORTRAN SYSTEM ROUTINES - (NONE) 0028 

• 0029 

• FORTRAN USAGE 0030 
» CALL M0VECS(LXY1,X1,Y1,LXY2,X2,Y2....,LXYN,XN,YN) 0031 

• 0032 
» THE ARGUMENT COUNT MUST BE A MULTIPLE OF 3 . IF NOT, 0033 

• AN IMPROPER RETURN WILL RESULT. 0034 
« 0035 
» INPUTS 0036 
» 0037 

• X1U) I = !.*.LXY1 IS FIRST VECTOR (ANY MODE) TO BE MSVED 0038 
» 0039 
« LXY1 EXCEEDS ZERO 0040 

• 0041 
» ETC 0042 

• 0043 

• XNII) 1*1.1. LXYN IS LAST VECTOR (ANY MODE) TO BE MOVED 0044 

• 0045 

• LXYN EXCEEDS ZERO 0046 

• 0047 
» OUTPUTS IF ANY LXY IS ZERO OR NEGATIVE THE CORRESPONDING 0048 
» VECTOR IS NOT MOVED. 0049 
» 0050 

• Y1U) I*l...LXYl WILL » XK1...LXY1) IF LXY1 EXCEEDS 0 0051 
» 0052 
» ETC 0053 

• 0054 

• YNU) I ~1 • • • LXYN WILL » XN(U».LXYN) IF LXYN EXCEEDS 0 0055 

• 0056 
» EQUIVALENCE IY(K) r X(L>) PERMITTED FOR ANY K,L HAIR. 0057 
» VECTORS ARE MOVED IN SAME ORDER AS THEY APPEAR IN THE 0058 

• ARGUMENT STRING 0059 
» 0060 

• EXAMPLES 0061 
» 0062 

• i. INPUTS - X( 1...3)=1.,2.,3. IX( 1...4)«1,2, 3,4 U«0.0 0063 
» USAGE - CALL MOVECS ( 3,X,Y,4»IX*IY»l,IX,IZ) 0064 
« CALL M0VECS(3,X,W,G,X,U*3,W,Z) 0065 

• OUTPUTS - Yd.. .3)«1. ,2. ,3. IY( 1*<..4) = 1,2, 3,4 IZ = i 0066 

• W(1...3) = i.,2.,3. U » 0.0 (NO OUTPUT CASE) 0067 
» ZU.4.3) » l.,2.,3. 0068 

• 0069 
» 2. INPUTS - SAME AS EXAMPLE 1. 0070 

• USAGE - CALL MOVECS ( 2,X(2),X(1),3,IX(1),IX(2)) 0071 
» OUTPUTS - X(1...3)=2.,3.,3. IX( 1.. .4)=1, 1,2,3 0072 

• 0073 
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• PROGRAM FOLLOWS BELOW 0074 



• 






0075 


* TRANSFER 


VECTOR HAS MOVE(LXY,X 


,Y ) 


0076 


HTR 


0 


XR4 ORIGINAL 


0077 


BCI 


1 , MOVECS 




0078 


• ONLY ENTRY. MOVECS tLXYl*Xl ,Y1 


, •••»LXYN,XN»YN) 


0079 


MOVECS SXD 


MOVECS-2,4 




0080 


• CHECK IF 


NEXT ARGUMENT IS TSX 


A,0 


0081 


GETLXY CAL 


1,4 




0082 


STA 


LXY 


(START SETTING MOVE CALL SEQUENCE) 


0083 


ANA 


MASK 




0084 


LAS 


TSXZ 




0085 


TRA 


LEAVE 


NO 


0086 


TRA 


MORE 


YES 


0087 


• EXIT WHEN 


FIRST OF TRIPLET IS 


NON— TSX A,0 


0088 


LEAVE TRA 


It* 


NO 


0089 


• COMPLETE 


CALLING SEQUENCE FOR 


MOVE. TSX$ * BACK FOR NEXT THREE 


0090 


MORE CLA 


2,4 




0091 


STA 


X 




0092 


CLA 


3,4 




0093 


STA 


Y 




0094 


SXA 


SV4,4 




0095 


TSX 


$M0VE,4 




0096 


LXY TSX 


• *,0 


*«=A(NEXT LXY) 


0097 


X TSX 


**40 


*»=A(NEXT X) 


0098 


Y TSX 


**,0 


**=A(NEXT Y) 


0099 


SV4 AXT 


»*#4 


**-XR4 VARIABLE 


0100 


TXI 


GETLXY, 4, -3 




0101 


» CONSTANTS 






0102 


MASK OCT 


777777700000 




0103 


TSXZ TSX 


0,0 




0104 


END 






0105 
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» MOVREV ( SUBROUTINE ) 9/29/64 LAST CARD III DECK IS NO, 0155 

* FAP 0001 
•MOVREV 0002 

COUNT 150 0003 

LBL MOVREV 0004 

ENTRY MOVREV (LXY, IX*.X*I Y,Y, SIGN) 0005 

* 0006 

* - ABSTRACT 0007 

* 0008 

* TITLE - MOVREV 0009 

* MOVE. REVERS# CHANGE SPACING, OR CHANGE SIGN OF A VECTOR 0010 
» 0011 

* MOVREV MOVES A VECTOR XU) TO YIJ) ACCORDING TQ 0012 
» 0013 

* YU) * SIGN*X(1) 0014 

* YU + IY) = SIGN*X(1+IX) 0015 

* . 0016 
» . 0017 

* YU+LXY»IY) = SIGN«X< 1+LXY»IX) 0018 

* 0019 

* OR ACCGROING TO 0020 

* 0021 

* YU) * SIGN«XU+LXY»IX) 0022 

* YU + IY) » SIGN*XU + <LXY-1)*IX) 0023 

* . 0024 

* . 0025 

* YU + LXY»IY) = SIGN«X(1) 0026 

* 0027 

* WHERE LXY * IX, IY, AND SIGN 1 = + 1. OR -I*) ARE INPUT 0028 
» PARAMETERS. OVERLAP OF INPUT AND OUTPUT IS ALLOWED 0029 

* EXCEPT WHEN THE REVERSE AND MOVE FEATURE ARE USED AT 0030 

* THE SAME TIME. 0031 
» 0032 
« LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0033 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0034 

* STORAGE - 74 REGISTERS 0035 

* SPEED - 100 + 10»LXY MACHINE CYCLES 0036 

* AUTHOR - R.A. WIGGINS, JULY, 1963 0037 

* 0038 

* — — USAGE 0039 

* 0040 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0041 
» AND FORTRAN SYSTEM ROUTINES - NONE 0042 
» 0043 
» FORTRAN USAGE 0044 

* CALL MOVREVlLXY»IX,X*IY,Y,SIGN) 0045 
» 0046 

* INPUTS 0047 
» 0048 

* LXY DEFINES NUMBER OF CATA VALUES TO BE MOVED. 0049 
» MUST BE GRTHN= 1 0050 

* 0051 

* IX DEFINES THE INCREMENT OF THE X INDEX. 0052 
» MUST BE GRTHN^O 0053 
» 0054 

* XU) I=1,1*IX,...,1+(LXY-1)*IX CONTAINS THE SERIES TO BE MOVED 0055 

* NEED NOT BE FLOATING POINT. 0056 
» 0057 
» IY DEFINES THE INCREMENT OF THE Y INDEX. 0058 
» IF NEGATIVE THE SERIES WILL BE REVERSED ON OUTPUT. 0059 

* 0060 
« SIGN IF GRTHN 0 THE SIGN IS NOT CHANGED 0061 

* IF LSTHN=0 THE SIGN OF EACH TERM MOVED IS CHANGED. 0062 

* 0063 

* OUTPUTS 0064 

* 0065 

* YU) I=i,l+IY,.*.,i+(LXY-l)*IY CONTAINS THE MOVED SERIES 0066 

* MAY OVERLAP XU) WHEN IY«1 0067 

* 0068 

* EXAMPLES 0069 
» 0070 
» 1. INPUTS - LXY=3 IX=l IY=2 XU...3) * l.,2.»3. 0071 

* SIGN=1. YU...6) * .l,.l,..*,.l 0072 

* OUTPUTS - YU...6) * l.,.i,2.,.l,3.,.l 0073 

* 0074 
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* 2. INPUTS 

* OUTPUTS 



SAME AS EXAMPLE 1. EXCEPT SIGN=-1 IX*0 
Yd.. .6) = -1. .1,-1.,.! 



» 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT IY--1 

* OUTPUTS - Yd.*. 3) » 3.,2.,U 
• 

• PROGRAM FOLLOWS BELOW 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 



XRi 


HTR 


0 




0083 


XR2 


HTR 


0 




0084 


XR4 


HTR 


0 




0085 




BCI 


1, MOVREV 




0086 


MOVREV 


SXD 


XR1,1 


SAVE 


0087 




SXO 


XR2,2 


INOEX 


0088 




SXD 


XR4,4 


REGISTERS AND 


0089 




STI 


SI 


INDICATORS. 


0090 




SIR 


3 


LOAD INDICATORS. 


0091 


CLA 


CLA 


5,4 


=ADR(X) 


0092 




STA 


DPA 




0093 




CLA 


3,4 


=ADR(Y) 


0094 




STA 


SPA 




0095 




SUB 


5,4 


DECIDE WHICH DIRECTION 


0096 




TMI 


*+2 


TO MOVE 


0097 




RIR 


3 


SAVE IN LEFT HALF INDICATOR 


0098 




PXD 


tO 


CHECK FOR ILLEGAL VALUES OF 


0099 




CAS* 


lt4 


LXY 


0100 


CLS 


CLS 


« 




0101 




TRA 


LV 


♦EXIT IF ZERO OR NEGATIVE* 


0102 




CAS* 


2,4 


AND IX 


0103 




TRA 


LV 


♦EXIT IF NEGATIVE* 


0104 




NOP 






0105 




LDQ 


CLA 




0106 




CAS* 


6,4 


CHECK SIGN CONVENTION 


0107 




NOP 






0108 




LDQ 


CLS 


ZERO OR NEGATIVE 


0109 




SLQ 


SPA 


POSITIVE. 


0110 




CAS* 


4,4 


CHECK SIGN OF IY 


0111 




SIR 


1 


SET 


0112 




RIR 


2 


INOICATORS 


0113 




ADM* 


4,4 




0114 




RNT 


2 




0115 




SUB 


=32768817 




0116 




STD 


TXI2 




0117 




CLA* 


2,4 




0118 




RNT 


1 




0119 




SUB 


=32768B17 




0120 




STD 


TXI1 




0121 




RNT 


1 




0122 




TRA 


XIX 




0123 




CLM 






0124 


Al 


PAX 


tl 




0125 




RNT 


2 




0126 




TRA 


XIY 




0127 




CLM 






0128 


A2 


PAX 


,2 




0129 




CLA* 


It* 




0130 




PDX 


t4 




0131 


SPA 


CLA 


**<1 




0132 


DPA 


STO 


**#2 




0133 


TXI1 


TXI 


*+l,i,#* 




0134 


TXI2 


TXI 


*+l, 2, #* 




0135 




TIX 


SPA, 4,1 




0136 


LV 


LDI 


SI 




0137 




LXD 


XR1,1 




0138 




LXD 


XR2,2 




0139 




LXD 


XR4,4 




0140 




TRA 


7,4 




0141 


XIX 


CLA* 


1,4 




0142 




SUB 


= 1B17 




0143 




XCA 






0144 




MPY* 


2,4 




0145 




ARS 


1 




0146 




TRA 


Al 




0147 


XIY 


CLA* 


1,4 




0148 




SUB 


= 1817 




0149 
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XCA 




MPY* 


4,4 


ARS 


1 


TRA 


A2 


PZE 




END 
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0150 
0151 
0152 
0153 
0154 
0155 
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MPSEQ1 {SUBROUTINE) 
FAP 



9/29/64 LAST CARD IN DECK IS NO* 



•MPSEQl 



COUNT 200 
LBL MPSEQ1 

ENTRY MPSEQl ( X,LX,B,LB, IX, IXLO, IANS) 

• — —ABSTRACT 

• 

» TITLE - MPSEQl 

» MAPS A SEQUENCE OF NUMBERS INTO AN INTEGER SERIES 

• 

• MPSEQl MAPS A SEQUENCE XU), I»H*%.,LX INTO AN INTEGER 

• SEQUENCE IXU), I«1,...,LX. THE MAPPING IS CONTROLLED BY 

• A GIVEN VECTOR OF RANGE LIMITS Btl), 1*1, ...S,LB,f WHERE 

• BUJ IS MONOTONELY INCREASING FROM BCD TO B{ LBI, THUS 

• SPECIFYING LB-1 SEPARATE RANGES. EACH RANGE IS CONSIDERED 

• CLOSED ON THE LOWER END, OPEN ON THE HIGH END AND THE 

• RANGES ARE INDEXED FROM IXLO+l TO IXLO+LB-ll WHERE tXLQ 

• IS A PARAMETER* IXC I) IS THEN SET EQUAL TO THE INDEX OF 
» THE RANGE TO WHICH XU) BELONGS, WITH THE FOLLOWING 

• TREATMENT OF EXTREMAL X VALUES 

• IF X(l) IS LSTHN B< 1), IX(I) = IXLO 

» IF X(l) IS GRTHN* BCLB), IXU) » IXLO+LB 

• NOTE- THE LOGIC USED IS ALMOST IDENTICAL TO THAT OF FRQCT2 
• 

• LANGUAGE - FAP SUBROUTINE WITH FORTRAN II CALLING SEQUENCE 

• EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 

• STORAGE - 110 REGISTERS 

• SPEED 

« AUTHOR - J. N. GALBRAITH 
• 

• -—USAGE — 
• 

• TRANSFER VECTOR CONTAINS ROUTINES - NONE 

• AND FORTRAN SYSTEM ROUTINES - NONE 
• 

• FORTRAN USAGE 

• CALL MPSEQl IX, LX ,B, LB, IX, IXLO, IANS) 
• 

» INPUTS 

• XU) 

• LX 
« 
» 

« B(I ) 

• LB 

• IXLO 

• OUTPUTS 
» IXU) 

• IANS 

» EXAMPLES 



1=1. . . LX IS THE INPUT SERIES TO BE MAPPED. 

MAY BE FLOATING, FORTRAN INTEGER, OR MACHINE LANGUAGE 
INTEGER, BUT MUST BE THE SAME MODE AS BU). 

IS LENGTH OF X VECTOR. 
MUST BE GRTHN= 1. 

1=1. * • LB GIVES INPUT RANGES OF MAPPING INTERVALS. 
MUST BE SAME MODE AS XU). 

BU) MUST INCREASE MONOTONELY, I.E. BU + 1) GRTHN BUli 



IS LENGTH OF RANGE VECTOR. 
MUST BE GRTHN=1. 

IS LOWER LIMIT OF OUTPUT MAPPING. 
LOWEST RANGE. 



IXLO+1 * INDEX OF 



I*I.«.fcX IS THE INTEGER MAPPING OF XU). 



*0 
= 1 
=2 
=3 



NORMAL 
ILLEGAL LX 
ILLEGAL LB 
WEIRD ERROR 



1. INPUTS - LX*0 XU»..16)=-5.,-4.,-3.2,-3.1,~2.,-2.1,0.#-l*l, 

-.5,5. 44. f 3. 5, 3., 2. 9% 1.1, 1. LB=16 B< 1 . ^.9 M-4,S ,-3. , 
-2.,-l.,0.,l.,2.,3.,4., IXLO=0 
OUTPUTS - ERROR IANS=1 



0196 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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» 3. 



4. 



INPUTS 
OUTPUTS 

INPUTS 
OUTPUTS 

INPUTS 
OUTPUTS 



X AND 8 SAME AS EXAMPLE 1 
ERROR IANS*2 



LX*16 LB*0 IXLO=0 



X AND B SAME AS EXAMPLE 1 LX=16 LB*9 IXLO*0 

IXf I, 16)*0,0, 0, 0,2, I, 4,2,3,7,7, 7,7,6, 5 t 5 IANS*0 

X, 8, LX, AND LB SAME AS EXAMPLE 3 IXL0=12 

IX(l,.i., 16)^12,12, 12, 12, 14, 13, 16,14,15,19419,19119,18, 

17,17 IANS=0 



MPSEQl 



LOOP 



TESTLO 
BTEST1 



TESTHI 



SEARCH 
XADD 
BADD 



LESS 



PZE 


0 




BCI 


1, MPSEQl 




SXA 


RETURN#1 




SXA 


RETURN*1, 


2 


SXA 


RETURN+2, 


4 


SXD 


MPSEQW, 


4 


STZ* 


7,4 




CLA» 


2,4 




TZE 


ERR1 




TMI 


ERR1 




STD 


END 




CLA« 


4,4 




TZE 


ERR2 




TMI 


ERR2 




ARS 


18 




STO 


LB 




ARS 


1 




STO 


LBHALF 




CLA 


1,4 




ADD 


K1MLI 




STA 


XADD 




STA 


TESTLO 




CLA 


3,4 




ADD 


KIMLI 




STA 


BTEST1 




STA 


BADD 




SUB 


LB 




STA 


TESTHI 




CLA* 


6,4 




SUB 


K2FX 




STO 


XLOW 




CLA 


5,4 




ADD 


KIMLI 




STA 


IXSTO 




AXT 


1,1 




AXT 


1,4 




CLA 


KIMLI 




STO 


LBLO 




CLA 


LB 




STO 


LBHI 




CLA 


LBHALF 




STO 


LBCOM 




AXT 


1,2 




CLA 


•*4\ 




CAS 


•**4 




TRA 


TESTHI 




TRA 


NEXIND 




TRA 


NEXIND 




CAS 


«* 




TRA 


HIEST 




TRA 


HIEST 




LXA 


LBCOM, 2 




CLA 


»*,'l 




CAS 


• *42 




TRA 


GRATER 




TRA 


NEXIND 




PXA 


0,2 




SUB 


LBLO 




CAS 


KIMLI 




TRA 


*+3 




TRA 


EQUAL 




TRA 


ERROR 




ARS 


1 




ADD 


LBLO 




LDQ 


LBCOM 





IANS=0 
GET LX 



GET LB 



LB IN ADDRESS 
LB/2 ( IN ADDRESS) 



ADDRESS OF X 
AtX+1) 



ADDRESS OF 8 
A(B+1) 



GET IXLO 
IXLO-2 



ADDRESS OF IX 
AdX + i) 



INITIAL LBL0=1 
INITIAL LBHI^LB 
INITIAL LBC0M=LB/2 

GET X. C««»AtX+l)) 

B(l) SEE IF IN LOWEST RANGE 

*« 3 A( Bl LB ) ) . SEE IF IN HIGHEST RANGE 



GET X< IR1I 

COMPARE WITH B( LBCOM) 

X GREATER, NEW LBLO (=LBCOM) 

GOT IT, SET IXURl + l) 

X LESS, NEW LBHI t=LBCOM) 

LBCOM— LBLO=D IF 

DIF GREATER THAN ONE 

DIF=1, GOT IT, SET IX(IR1*1) 

IMPOSSIBLE 
DIF/2 
NEW LBCOM 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
OHO 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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STQ 


LBHI 






0150 




STO 


LBCOM 






0151 




TRA 


SEARCH 






0152 


GRATER 


PXA 


0,2 






0153 




SUB 


LBHI 


LBCOM-LBHI* 


-DIF 


0154 




SSP 




DIF 




0155 




CAS 


KIMLI 






0156 




TRA 


*+3 






0157 




TRA 


NEXIND 


DIF=1, GOT 


IT, SET IX<IR1+1) 


0158 




TRA 


ERROR 


IMPOSSIBLE 




0159 




ARS 


1 






0160 




ADO 


LBCOM 






0161 




LDQ 


LBCOM 






0162 




STO 


LBCOM 






0163 




STQ 


LBLO 






0164 




TRA 


SEARCH 






0165 


NEXIND 


TXI 


»+l,2,l 






0166 


EQUAL 


PXD 


,2 






0167 




ADD 


XLOW 






0168 


IXSTO 


STO 


»«#1 


**** ADDRESS 


OF IX+1 


0169 




TXI 


♦♦1,1,1 






0170 


END 


TXL 


L00P,1,«» 


**=LX 




0171 


RETURN 


AXT 


»*,1 






0172 




AXT 


**, 2 






0173 




AXT 


»*#4 






0174 




TRA 


8,4 






0175 


HIEST 


LXA 


LB, 2 






0176 




TRA 


EQUAL 






0177 


ERR1 


CLA 


KIFX 






0178 




STO» 


7,4 


STORE IANS 




0179 




TRA 


8,4 


RETURN 




0180 


ERR2 


CLA 


K2FX 






0181 




TRA 


ERRl+l 






0182 


ERROR 


CLA 


K3FX 






0183 




TRA 


ERRl+l 






0184 


» CONSTANTS 


AND TEMPORARIES 






0185 


KIFX 


PZE 


0,0,1 






0186 


K2FX 


PZE 


0,0,2 






0187 


K3FX 


PZE 


0,0,3 






0188 


KIMLI 


PZE 


1,0,0 






0189 


LB 


PZE 


0 






0190 


LBHALF 


PZE 


0 






0191 


LBLO 


PZE 


0 






0192 


LBCOM 


PZE 


0 






0193 


LBHI 


PZE 


0 






0194 


XLOW 


PZE 








0195 




END 








0196 
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• MRVRS (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0066 

» LABEL 0001 

CMRVRS 0002 

SUBROUTINE MRVRS (N f M,LA,AA) 0003 

C 0004 

C -ABSTRACT 0005 

C 0006 

C TITLE - MRVRS 0007 

C REVERSE VECTOR OF MATRICES 0008 

C 0009 

C MRVRS REVERSES THE ORDER OF MATRICES IN A VECTOR* 0010 

C 0011 

C LANGUAGE - FORTRAN II SUBROUTINE 0012 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0013 

C STORAGE - 61 REGISTERS 0014 

C SPEED -» 10*N*M»LA ♦ 4l*LA ♦ 110 MACHINE CYCLES ON THE TC90 0015 

C WHERE N*M IS THE NUMBER OF ELEMENTS IN A MATRIX AND 0016 

C LA IS THE NUMBER OF MATRICES IN THE VECTOR. 0017 

C AUTHOR - R.A. WIGGINS 3/63 0018 

C 0019 

C -USAGE 0020 

C 0021 

C TRANSFER VECTOR CONTAINS ROUTINES - REVERS 0022 

C AND FORTRAN SYSTEM ROUTINES - INOT ANY) 0023 

C 0024 

C FORTRAN USAGE 0025 

C CALL MRVRS ( N*M#LA f AA) 0026 

C 00£7 

C INPUTS 6#28 

C 0029 

C N IS NUMBER OF ROWS IN A MATRIX IN AA. 0030 

C MUST BE GRTHN-1 0031 

C 0032 

CM IS NUMBER OF COLUMNS IN A MATRIX IN AA. 0033 

C MUST BE GRTHN= I 0034 

C 0035 

C LA IS NUMBER OF MATRICES IN THE VECTOR OF MATRICES AA. 0036 

C MUST BE GRTHN- 1 0037 

C 0038 

C AA(I) 1*1,.. J,LA*N*M IS A VECTOR OF MATRICES STORED CLOSELY 0039 

C PACKED. 0040 

C 0041 

C OUTPUTS 0042 

C 0043 

C AAU) I = l,i.*,LA*N*M IS THE REVERSED INPUT VECTOft. 0044 

C 0045 

C EXAMPLES 0046 

C 0047 

C 1. INPUTS - N=l M=l LA*1 AA(1)«3. 0048 

C OUTPUTS - AU)*3. 0049 

C 0050 

C 2. INPUTS - N=2 M=l LA=3 AA( 1 . . .6 )= 1 . , 2. , 3. , 4. , 5. , 6. 0051 

C OUTPUTS - AAU...6)=5.,6. f 3., 4., 1., 2. 0052 

C 0053 

C 3. INPUTS - N=2 M=l LA=4 AA( 1 . . .8 , 2. , 3. , 4. , 5. , 6. , 7. , 8. 0054 

C OUTPUTS - AAti*..8)=7.,8.,5.,6.,3.,4.tl.,2. 0055 

C 0056 

C PROGRAM FOLLOWS BELOW 0057 

C 0058 

DIMENSION AA(2) 0059 

NM = N»M 0060 

NMLA = NM*LA 0061 

CALL REVERS ( NMLA f AA) 0062 

DO 10 1-1 tNMLAf NM 0063 

10 CALL REVERStNM, AAU)) 0064 

RETURN 0065 

END 0066 
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» MSCON1 { SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0107 

• LABEL 0001 

CMSC0N1 0002 

SUBROUTINE MSC0N1 { NORDER, P, PHI , DEPEND, IANS ) 0003 

C 0004 

C -ABSTRACT 0005 

C 0006 

C TITLE - MSC0N1 0007 
C MEAN SQUARE CONTINGENCY AND DEPENDENCY FROM PROBABILITY DENSITY* 0008 

C 0009 

C MSC0N1 COMPUTES THE MEAN SQUARE CONTINGENCY AND A 0010 

C DEPENDENCY MEASURE AS DEFINED ON PAGE 282 OF CRAMER t 0011 

C MATHEMATICAL METHODS OF STATISTICS^ PRINCTON UNlVrf PRESS 4 0012 

C 1951. THE COMPUTATION REQUIRES THE SECOND PRQBASILITY 0013 

C DENSITY WHICH CAN BE COMPUTED WITH SUBROUTINE PR0B2 f SEE 0014 

C WRITE-UP OF PR0B2) • IF PHI IS THE MEAN SQUARE CONTINGENCY, 0015 

C DEPEND IS THE DEPENDENCY MEASURE, AND NORDER IS TWE ORDER 0016 

C OF THE SECOND PROBABILITY MATRIX, P(l,J), THEN 0017 

C 0018 

C DEPEND « PHIZ(NORDER-l) 0019 

C 0020 

C LANGUAGE - FORTRAN II SUBROUTINE 0021 

C EQUIPMENT - 709* 7090 (MAIN FRAME ONLY) 0022 

C STORAGE - 238 REGISTERS 0023 

C SPEED - 0024 

C AUTHOR J.N. GALBRAITH 0025 

C 0026 

C USAGE 0027 

C 0028 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0029 

C AND FORTRAN SYSTEM ROUTINES - NONE 0030 

C 0031 

C FORTRAN USAGE 0032 

C CALL MSC0N1 (NORDER, P, PHI, DEPEND, IANS) 0033 

C 0034 

C INPUTS 0035 

C 0036 

C NORDER INTEGER. THE ORDER OF THE P(I,J), PROBABILITY DENSITY 0037 

C MATRIX. GRTHN ONE, LSTHN OR EQUAL 25. 0038 

C 0039 
C P(I,J) I*i,..,NORDER, J=l , . . » NORDER. PROBABILITY DENSITY MATRIX 0040 

C NORMALIZED SUCH THAT THE SUM OVER I AND J I S = TO li 0041 

C P(I,J) HAS OIMENSION (25,25), P(I,J) MUST NOT HAVE AN 0042 

C ENTIRE ROW OR COLUMN SUM EQUAL TO ZERO, OR NEGATIVES 0043 

C 0044 

C OUTPUTS 0045 

C 0046 

C PHI THE MEAN SQUARE CONTINGENCY. 0047 

C 0048 

C DEPEND THE DEPENDENCY MEASURE. 0049 

C 0050 

C IANS ERROR INDICATOR 0051 

C =0 NORMAL 0052 

C «-l ILLEGAL NORDER. LSTHN 1 OR GRTHN 25 0053 

C *-2 ILLEGAL P MATRIX. ROW OR COLUMN SUM ZERO OR NEGATIVE. 0054 

C 0055 

C EXAMPLES 0056 

C 0057 

C U INPUTS - P(1,1M.2 frPtI,I)tI*2t5 *.l, P(1,I),I«2,5 =*.l 0058 

C ALL OTHER P(I,J)=0. 0059 

C NORDfcR=*0 0060 

C OUTPUTS - PHI=0. DEPEND=0. IANS=-1 0061 

C 0062 

C 2. INPUTS - SAME AS EXAMPLE 1 EXCEPT 0063 

C NORDER-26 0064 

C OUTPUTS - PHI*0. DEPEND-O. IANS=-1 0065 

C 0066 

C 3. INPUTS - SAME AS EXAMPLE 1 EXCEPT 0067 

C N0RDER=*5 0068 

C OUTPUTS - PHI^l. 6666666 DEPEND 3 . 4 1666666 IANS*0 0069 

C 0070 

C 4. INPUTS - SAME AS EXAMPLE 1 EXCEPT 0071 

C P(l,5M0., P(5,l) = .l N0RDER*5 0072 

C OUTPUTS - PHI=1. 7333333 DEPEND*. 43333333 IANS=0 0073 

C 0074 
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C 5* INPUTS - SAME AS EXAMPLE 4 EXCEPT 
C P<5,5)*0, 
C OUTPUTS - IANS*-2 
C 

DIMENSION P(25,25),PSROW{25),PSCOL<25) 
C CHECK NORDER 

IANS=-1 

IF ( NORDER— 1 f 9999,9999,5 

5 IF(N0RDER-26) 6*9999,9999 
C FIND ROW AND COLUMN SUMS 

6 DO 10 J=l, NORDER 
PSROW( J)=0. 
PSCOLt J)=0, 

DO 10 1=1, NORDER 
PSROWt J)=PSROW<a)+PI J, I ) 
10 PSCOL< J) = PSCCLU) + PU,J) 
C CHECK ROW AND COLUMN SUMS 

IANS^-2 

DO 15 1=1 f NORDER 

IF(PSR0W(I)1 9999,9999,12 
12 IFtPSCOLUU 9999,9999,15 
15 CONTINUE 
C COMPUTE MEAN SQUARE CONTINGENCY 

PHI=0. 

DO 20 I=1,N0RDER 

DO 20 J=l, NORDER 
20 PHI = PHI + PU i J)«PU,J)/(PSROW( I)*PSCOLIJ) ) 

PHI=PHI-1. 
C COMPUTE DEPENDENCY MEASURE 

DEPEND=PHI/1FL0ATF(N0RDER-1) ) 

IANS=0 
9999 RETURN 

END 
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* MULK -II (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0077 

« LABEL 0001 

CMULK -II 0002 

SUBROUTINE HULK (C) 0003 

C 0004 

C — — ABSTRACT 0005 

C 0006 

C TITLE - MULK -II 0007 

C MULTIPLY ANY NO. OF VARIABLES BY A SINGLE FLTG. PT. CONSTANT 0008 

C 0009 

C MULK IS A VARIABLE-LENGTH-CALL ING-SEOUENCE SUBROUTINE 0010 

C WHICH MULTIPLIES EACH OF ITS ARGUMENTS BEYOND THE FIRST 0011 

C BY THE FIRST ARGUMENT, ASSUMEO TO BE FLOATING HOINTi 0012 

C 0013 

C THIS SUBROUTINE IS THE FORTRAN EQUIVALENT OF THE 0014 

C FAP SUBROUTINE OF THE SAME NAME. 0015 

C 0016 

C LANGUAGE - FORTRAN II SUBROUTINE 0017 

C EQUIPMENT - 709 OR 7090 CMAIN FRAME ONLY) 0018 

C STORAGE - 76 REGISTERS 0019 

C SPEED - 0020 

C AUTHOR - S.M. SIMPSON, AUGUST 1963 0021 

C 0022 

C USAGE 0023 

C 0024 

C TRANSFER VECTOR CONTAINS ROUTINES - SETUP, ARG, STORE, RETURN 0025 

C AND FORTRAN SYSTEM ROUTINES - I NONE) 0026 

C 0027 

C FORTRAN USAGE 0028 

C CALL MULK (C,Xi *X2,... ,XN> 0029 

C 0030 

C INPUTS 0031 

C 0032 

C C IS THE VALUE BY WHICH XU..XN ARE TO BE MULTIPLIED 0033 

C MUST BE FLTG. PT. 0034 

C 0035 
C OUTPUTS NO OUTPUTS IF ARGUMENT COUNT IS LESS THAN 2 <PURE RETURN! 0036 

C 0037 

C XI * C * XI 0038 

C X2 = C * X2 0039 

C ETC. 0040 

C XN = C » XN 0041 

C 0042 

C EQUIVALENCES OF ANY ARGUMENTS ARE PERMITTED, THE 0043 

C BEHAVIOUR DEPENDS ON THE FACT THAT Xl.i.XN ARE SET 0044 

C IN THAT ORDER. 0045 

C 0046 

C C IS AN OUTPUT IF ANY X IS EQUIVALENT TO C. IF SO 0047 

C SUCCEEDING ARGUMENTS ARE MULTIPLIED BY THE NEW C^ 0048 

C 0049 

C EXAMPLES 0050 

C 0051 

C 1. INPUTS - X=l. , Y=2., Z=3. t U=4. , V=5., W=6. 0052 

C USAGE - CALL MULK { 2.,X,Y,Z,U) 0053 

C CALL MULK<V,W) 0054 

C CALL MULK(V) 0055 

C CALL MULK 0056 

C OUTPUTS - X=2.^ Y=4. , Z=6., U=8. 0057 

C W=30., 0058 

C V*5. 0059 

C NO OUTPUTS FROM LAST TWO CALLS 0060 

C 0061 

C 2. INPUTS - SAME AS EXAMPLE 1 EXCEPT C * 2. 0062 

C USAGE - CALL MULK CC, X, Y, Z, C, U, V, V, W> 0063 

C OUTPUTS - X=2., Y=4., Z=6. t C=4*, U=16., V=80.# W = 24* 0064 

C 0065 

C PROGRAM FOLLOWS BELOW 0066 

C 0067 

C GET ARGUMENT COUNT AND CHECK IT 0068 

CALL SETUPC L0CALL,NARGS,XR1,XR2 ) 0069 

IF (NARGS-2) 9999,10,10 0070 

C LOOP TO SET Xl.J.XN 0071 

10 DO 20 NUMARG*2#NARGS 0072 

XOUT=C*ARGF (LOCALL»NUMARG, 1 ) 0073 

20 CALL ST0RE(X0UT^L0CALL,NUMARG,1) 0074 
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C EXIT 

9999 CALL RETURN ILOC ALL »XRl» XR2 ) 
END 
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» MULLER i SUBROUTINE ) 9/9/64 LAST CARD IN BECK IS NO. 0231 

» LABEL 0001 

CMULLER 0002 
SUBROUTINE MULLER (COE, Nl, ROOTR, ROOT I) 0003 

C 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - MULLER 0008 

C POLYNOMIAL RC@T FINDER 0009 

C 0010 

C MULLER FINDS THE REAL AND COMPLEX ROOTS OF A POLYNOMIAL 0011 

C WITH REAL COEFFICIENTS. THE METHOD USED IS TAKEN FROM 0012 

C MULLER! 'A METHOD OF SOLVING ALGEBRAIC EQUATIONS USING 0013 

C AN AUTOMATIC COMPUTER', MTAC (1956), 280-215. 0014 

C 0015 

C ALL ARITHMETIC IS DONE IN THE COMPLEX MODE. THEREFORE 0016 

C ALL ROOTS FOUND WILL HAVE REAL AND IMAGINARY PARTS. 0017 

C REAL ROOTS WILL HAVE SMALL IMAGINARY PARTS ON THE OROER 0018 

C OF 7 DECIMAL PLACES LESS THAN THE REAL PARTS. 0019 

C 0020 

C THE PROGRAM WILL FINO MULTIPLE ROOTS BUT THE ACCURACY 0021 

C DECREASES AS THE MULTIPLICITY INCREASES. A NON-MULTIPLE 0022 

C ROOT IS NORMALLY ACCURATE FROM 6 TO 8 DECIMAL f LACES. 0023 

C WHEN THE MULTIPLICITY IS 4, THE ACCURACY DECREASES 2 0024 

C DECIMAL PLACES. 0025 

C 0026 

C LANGUAGE - FORTRAN II SUBROUTINE 0027 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0028 

C STORAGE - 757 REGISTERS 0029 

C SPEED - ABOUT .010*N»N SECONDS ON THE 7094 MOD 14 0030 

C WHERE N IS THE DEGREE OF THE POLYNOMIAL. 0031 

C AUTHOR - IRA HANSON, LMSN, SUNNYVALE CAL. JUNE, i960 0032 

C 0033 

C 0034 

C •* USAGE 0035 

C 0036 

C TRANSFER VECTOR CONTAINS ROUTINES - «NOT ANY) 0037 

C AND FORTRAN SYSTEM ROUTINES - SQRT 0038 

C 0039 

C FORTRAN USAGE 0040 

C CALL MULLER (COE ,N1 , ROOTR, ROOT I ) 0041 

C 0042 

C 0043 

C INPUTS 0044 

C 0045 

C COE(I) I=1,*..,N1+1 IS THE ARRAY OF POLYNOMIAL COEFFICIENTS* 0046 

C 0047 

C Nl IS THE DEGREE OF THE POLYNOMIAL 0048 

C MUST BE GRTHN- 1 0049 

C 0050 

C 0051 

C OUTPUTS 0052 

C 0053 

C ROOTRU) I = l,k.J,Nl IS THE REAL PARTS OF THE COMPLEX RO0TS. 0054 

C 0055 

C ROOTI(I) I*t,..W,Nl IS THE CORRESPONDING IMAGINARY PARTS OF THE 0056 

C COMPLEX ROOTS. 0057 

C 0058 

C 0059 

C EXAMPLES 0060 

C 0061 

C 1. INPUTS - Nl » 2 C0EU...3) * 2.21,-1*00,1.00 0062 

C OUTPUTS - ROOTRU. ..2) * 0.5, 0.5 0063 

C R00TK1...2) = 1.4,-1.4 0064 

C 0065 

C 2. INPUTS - Nl = 10 C0EU...11) * 1332. 5,-7690. 8, 261 30. ,-46510* , 0066 

C 51730., -38520., 19350. *-6 153. 9, 968. 28,-4. 2000 A*GO00 0067 

C OUTPUTS - ROOTRU. ..10) = 0.2, 0.2, 1.5, 1.5, 1.0, 1.0, 0.5* 0*5, 0068 

C -1.1,-1.1 0069 

C R00TIU...10) *-0.3, 0.3, 0*4,-0.4,-1.0, 1.0,-1.4# 1*4, 0070 

C -31.0, 31.0 0071 

C 0072 

C PROGRAM FOLLOWS BELOW 0073 

C 0074 
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OIMENSION CQEU6) , ROOTR< 15 ) * ROOT I C 15 ) 

N»N1 

N2=N+1 

N4=0 

1 = 1 

19 IFtC0EU))9,7,9 
7 N4«N4+1 

ROOTR(N4)*0. 
ROOT UN4 3=0. 
1*1*1 

IF(N4-N U9 f 37,19 
9 CONTINUE 

10 AXR=0.8 
AXI=0. 
L=l 

N3 = l 

ALPIR=AXR 
ALPII'AXI 
M=l 

G0T099 

11 BET1R«TEMR 
BETH-TEMI 
AXR*0.85 
ALP2R=AXR 
ALP2I-AXI 
M=2 

G0T099 

12 BET2R=TEMR 
BET2I=TEWI 
AXR=0.9 
ALP3R=AXR 
ALP3I=AXI 
M=3 

G0T099 

13 BET3R-TEMR 
BET3 I=TEMI 

14 T£1=ALP1R-ALP3R 
T£2=ALP1I-ALP3I 
TE5-ALP3R— ALP2R 
TE6=ALP3I-ALP2I 
TEM=TE5*TE5+TE6«TE6 

Tfc3= ( TEl*TE5+TE2*TE6 ) /TEM 

TF4= ( TE2*T£5-TE1*T£6 ) /TEM 

TE7=TE3+1. 

TE9=TE3*TE3— TE4*TE4 

TE10*2.*TE3*TE4 

DE15-TE7*BET3R-TE4*BET3 I 

DE16=TE7*BET3I +TE4»BET3R 

TE11«TE3*BET2R-TE4*BET2I+BET1R-DE15 

TE12=TE3*BET2I+TE4*BET2R+BET1I-D£16 

TE7=TE9-1. 

TEl=TE9*BET2R-TE10*BET2I 

TE2*TE9*BET2I*Tf 10«8ET2R 

TE 13=TE1-BETIR-TE7*BET3R+TE10*BET31 

TE14=TE2-BET1 I-TE7*BET3I-TE10*BET3R 

TE15=DE15*TE3-DE16*T£4 

TE16=DE15«TE4+DE16*TE3 

T£1=TE13*TE13-TE14*TE14-4.*{TE11»TE15-TE12*TE16) 

TE2=2.»TE13*T£14-4.»tTE12»TEl5-i-TEll»TE16) 

TEM=SQRTF(TE1*T£H-TE2*TE2) 

IF(TE1)113,113,112 
113 TE4=SQRTFi .5*1 TEM-TEl) ) 

TE3=.5*TE2/TE4 

GO TO 111 
112 TE3=SQRTFU5MTEM + TE13) 

IF(TE2)110t200t200 

110 T£3=-TE3 

200 TE4=.5*TE2/TE3 

111 TE7=TE13+TE3 
TE8*TE14+TE4 
TE9=TE13-TE3 
TE10«TE14-TE4 
TE1=2.»TE15 
TE2=2.«TE16 

IF (TE7*TE7+TE8»TE8-TE9*TE9-TE10*TE 10 )204,204,205 
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204 TE7=TE9 
TE8=TE10 

205 TE M-T£7*TE7HfcTE8*TE8 
TE3=(TE1*TE7+TE2*TE8 )/TEM 
TE4= ( TE2*TE7~TE1*TE8 )7TEM 
AXR=ALP3R+TE3»TE5-TE4*TE6 
AXI=ALP3I+TE3«TE6+TE4»TE5 
ALP4R«AXR 

ALP4I*AXI 
M*4 

GO TO 99 

15 N6*l 

38 IFf ABSFf HELfc J +ABSF ( BELL )-l«E-20 ) 18, 18,16 

16 TE7=ABSF(ALP3R-AXR)+ABSF(ALP3I-AXI) 
IF(TE7/(A8SF<AXR)+A8SF(AXn)-l.E-7)18, 18,17 

17 N3=N3*-1 
ALP1R=ALP2R 
ALP1I=ALP2I 
ALP2R=ALP3R 
ALP2I=ALP3I 
ALP3R*ALP4R 
ALP3I-ALP4I 
BET1R=BET2R 
BET1I«BET2I 
BET2R=BET3R 
BET2I=BET3I 
BET3R=TEMR 
BET3I«TEMl 
IF(N3-100H4, 18,18 

18 N4=N4+1 
R00TR<N4)=ALP4R 
ROOTI (N4)=ALP4I 
N3«0 

41 IF(N4~N )30,37,37 
37 CONTINUE 

DO 380 1*1, N 

IF ( ABSF ( ROOT I(I))-l«E-5) 370,370,380 
370 ROOTIU)=0. 
380 CONTINUE 

RETURN 

30 I F ( ABSF { ROOT I(N4))-l.E-5) 10, 10,31 
31 L*L 

GO TO (32,10),L 

32 AXR^ALPIR 
AXI=-ALP1I 
ALP1I=-ALP1I 
M=5 

GO TO 99 

33 BEUR'TEMR 
BET1 I*TEMI 
AXR=ALP2R 
AXI=-ALP2I 
ALP2I=-ALP2I 
M*6 

GO TO 99 

34 BET2R*TEMR 
BET2I=TEMI 
AXR=ALP3R 
AXl=-ALP3I 
ALP3I*-*ALP3I 
L=2 

M=3 

99 TEMR^COE ( N2) 
TEMI=0.0 
DO 100 1*1, N 
U=N2-I 

TE 1=TEMR*AXR— TEMI*AXI 
TEMI=TEMI *AXR*TEMR*AX I 
100 TEMR- TE1*C0E(II> 
HELL-TEMR 
BELL=TEMI 

42 IF(N4) 102,103,102 
102 001011=1, N4 

TEMl =AXR— ROOTR { I ) 
TEM2=AXI-R0GTIU) 
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TE1 = TEMI*TEMH-TEM2*TEM2 
TE2=(TEMR*TEMH-TEMI*TEM2)/TEl 
TEMI=(TEMI»TEM1~TEMR«TEM2)/TE1 
101 TEMR=TE2 
103 M=M 

GO T0(11»12«13 9 15*33*34)«H 
END 
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» MULPLY ( SUBROUTINE) 9/29/64 LAST CARD IN ©iCK IS NO. 0113 

» FAP 0001 

•MULPLY 0002 

COUNT 150 0003 

LBL MULPLY 0004 

ENTRY MULPLY ( X, LX,XMLPLR,XMLPLO) 0005 

ENTRY XMLPLY U X, LIX , IXMPLR, IXMPLD) 0006 

• 0007 
» * ABSTRACT 0008 

• 0009 
» TITLE ~ MULPLY WITH SECONDARY ENTRY XMLPLY 0010 

• MULTIPLY VECTOR BY FLOATING OR FIXED CONSTANT 0011 

• 0012 
» MULPLY SETS A VECTOR EQUAL TO A GIVEN VECTOR TIMES A 0013 

• FLTG CONSTANT, OUTPUT MAY REPLACE INPUT* 0014 
» 0015 

• XMLPLY SETS A VECTOR EQUAL TO A GIVEN VECTOR TIMES A 0016 

• FXD CONSTANT. OUTPUT MAY REPLACE INPUT* 0017 
» 0018 
» LANGUAGE - FAP SUBROUTINES (FORTRAN-II COMPATIBLE) 0019 

• EQUIPMENT - 709 OR 7090 < MAIN FRAME ONLY) 0020 

• STORAGE - 34 REGISTERS 0021 

• SPEED - 7090 709 0022 

• MULPLY 40 ♦ (19 OR 22.2)»LX MACHINE CYCLES, 0023 

• XMLPLY 42 ♦ (20.6 OR 24.8)»LX LX « VECTOR LENGTH 0024 

• AUTHOR - S.M. SIMPSON, AUGUST 1963 0025 

• 0026 
» + USAGE 0027 

• 0028 

• TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0029 

• AND FORTRAN SYSTEM ROUTINES - (NONE) 0030 

• 0031 

• FORTRAN USAGE 0032 

• CALL MULPLY V X, LX,XMLPLR,XMLPLD ) 0033 
» CALL XMLPLYIIX,LIX, IXMPLR, IXMPLO) 0034 

• 0035 

• INPUTS 0036 

• 0037 

• XU) I=1.*.LX IS A FLTG VECTOR 0038 
« 0039 

• LX SHOULD EXCEED ZERO 0040 

• 0041 

• XMLPLR IS A FLTG VARIABLE. EQUIVALENCE IXMLPLR, SOME *< II) IS OK 0042 

• 0043 
» IXCI) 1=1.*. LIX IS A FXD VECTOR 0044 

• 0045 

• LIX SHOULD EXCEED ZERO 0046 
» 0047 

• IXMPLR IS A FXD VARIABLE. EQUIVALENCE (IXMPLR, SOME IX(I)) IS OK 0048 

• 0049 
» OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LX OR LIX LSTHN 1. 0050 

• 0051 
» XMLPLDU) 1=1.*. LX HAS VALUES XMLPLR * XU) 0052 

• EQUIVALENCE (XMLPLD,X) IS PERMITTED. 0053 

• 0054 

• IXMPLDII) 1=1. #. LIX HAS VALUES IXMPLR * IXII) 0055 
» EQUIVALENCE (IXMPLD,IX) IS PERMITTED. 0056 

• 0057 

• THE INITIAL VALUE OF THE MULTIPLIER IS USED THRUOUT^ 0058 
» 0059 

• EXAMPLES 0060 
» 0061 

• 1. INPUTS - X(1...4)=l.,2.,3.,4. IXC 1 . . .4 ) * 1, 2,3, 4 U*0.0 0062 

• USAGE - CALL MULPLY ( X, 4, 2* , Y ) 0063 
» CALL XMLPLY(IX,4,2,IY) 0064 
» CALL MULPLY(X f 1,2.,Z) 0065 
» CALL MULPLY(X,0,2*,U) 0066 
» CALL MULPLY(X,4,XC3),X) 0067 

• OUTPUTS - Y(l...4)=2.,4.,6.,8. IY( 1 . . . 4)=2, 4, 6, 8 0068 

• Z=2. 131*0.0 INO OUTPUT CASE) X ( 1. . *4)=3. , 6. , 9. , 12* 0069 
» 0070 

• PROGRAM FOLLOWS BELOW 0071 

• 0072 
» NO TRANSFER VECTOR 0073 

HTR 0 XR4 0074 
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BCI 


1, MULPLY 




0075 


• PRINCIPAL 


ENTRY. MULPLY<X,LX 


,XMLPLR» XMLPLD ) 


0076 


MULPLY 


CLA 


FMP 




0077 




LDQ 


NOP 




G078 


SETUP 


STO 


MLPLY 




0079 




STQ 


VARY 




0080 




SXD 


MULPLY-2,4 




0081 


Kl 


CLA 


It* 




0082 




ADD 


Kl 


A(X)+1 


0083 




STA 


GET 




0084 




CLA 


4,4 




0085 




ADD 


Kl 


A(XMLPLD)+1 


0086 




STA 


STORE 




0087 




CLA* 


3,4 


XMLPLR 


0088 




STO 


TEMP 




0089 




CLA* 


2,4 


LX 


0090 




TMI 


LEAVE 




0091 




PDX 


0,4 




0092 




TXL 


LEAVE, 4,0 




0093 


* MULTIPLICA 


TION LOOP 




0094 


GET 


LDQ 


**,4 


***Aixm 


0095 


MLPLY 


NOP 




= FMP TEMP OR MPY TEMP 


0096 


VARY 


NOP 




* NOP OR ALS 17 


0097 


STORE 


STO 


** ,4 


**=A(XMLPLD)«-1 


0098 




TIX 


GET, 4,1 




0099 


* EXIT 








0100 


LEAVE 


LXD 


MULPLY-2,4 




0101 




TRA 


5,4 




0102 


» SECOND ENTRY. XMLPL Y I I X , LI X* 


IXMPLR, IXMPLD) 


0103 


XMLPLY 


CLA 


MPY 




0104 




LDQ 


ALS 




0105 




TRA 


SETUP 




0106 


» CONSTANTS, 


VARIABLES 




0107 


FMP 


FMP 


TEMP 




0108 


NOP 


NOP 






0109 


MPY 


MPY 


TEMP 




0110 


ALS 


ALS 


17 




0111 


TEMP 


PZE 




MULTIPLIER 


0112 




END 






0113 
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» MUVADD (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO* 0244 

• FAP 0001 
•MUVADD 0002 

COUNT 200 0003 

L8L MUVADD 0004 

ENTRY MUVADO ( IV, ILO, IH I , LADD, MUVSUM, NSUMS, I ANS) 0005 

• 0006 
» — —ABSTRACT 0007 

• 0008 

• TITLE - MUVADD 0009 
« FAST MOVING SUMMATION OF A FIXED POINT VECTOR 0010 

• 0011 

• MUVADD MAKES A MOVING SUMMATION (OVER A SPECIFIED SUMMING 0012 
» LENGTH) OF A FIXED POINT FORTRAN SECTOR WITHIN A 0013 

• SPECIFIED RANGE OF THE VECTOR. OVERFLOW CHECK »S MADE! 0014 

• 0015 

• LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0016 

• EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0017 

• STORAGE - 129 REGISTERS 0018 

• SPEED - FOR VECTORS LONG WITH RESPECT TO SUMMING LENGTH TIME 0019 

• IS LENGTH OF RANGE TIMES 10 MACHINE CYCLES 0020 

• AUTHOR -» S.M. SIMPSON JR, MAY 1962 0021 

• 0022 
» ——USAGE — «»- 0023 

• 0024 

• TRANSFER VECTOR CONTAINS ROUTINES - NONE 0025 
» AND FORTRAN SYSTEM ROUTINES - NONE 0026 
» 0027 

• FORTRAN USAGE 0028 

• CALL MUVADDUV, ILO, IHI, LADD, MUVSUM, NSUMS, IANS) 0029 

• 0030 

• INPUTS 0031 

• 0032 

• IV(I) I=IL0.^.IHI IS THE SPECIFIED VECTOR RANGE. 0033 

• 0034 

• ILO MUST EXCEED 0 0035 

• 0036 

• IHI MUST EQUAL OR EXCEED ILO 0037 

• 0038 

• LADD IS THE SUMMING LENGTH. IT MUST EXCEED 0. 0039 

• 0040 

• OUTPUTS 0041 

• 0042 

• MUVSUM(I) 1=1,2,.. ., NSUMS CONTAINS THE MOVING SUMS 0043 

• WHERE 0044 

• MUVSUMt 1) = IV( ILO)+IV( ILO+l)+..*+IV< ILO+LABD-H 0045 

• MUVSUM(2)=IV( ILO+miV( IL0*2)+;i.+IV( ILO+fcADD) 0046 
« ETC. 0047 
» M(DVSUM(NSUMS) = IV( IHI-LADD+1 )♦...+ I V( IMI-ll+f VC IHI ) 0048 

• NOTE - SEE EXCEPTION BELOW UNDER IANSi 0049 

• 0050 

• NSUMS » IHI-IL0+2-LADD OR ONE, WHICHEVER IS LARGER. 0051 

• 0052 
» IANS » 0 MEANS JOB IS DONE 0053 

• =1 MEANS LADD EXCEEDED LENGTH OF RANGE. IN THIS CASE 0054 

• NSUMS IS SET =1. 0055 

• MEANS ILLEGAL SPECIFICATION OF ILO^ IHI, OR LAOO 0056 

• ( NSUMS WILL =0). 0057 

• =-2 MEANS OVERFLOW OCCURRED BUT ALL SUMS COMPUTED* 0058 

• 0059 
» EXAMPLES 0060 

• 0061 

• 1* INPUTS - IVll.. .10)*!, 2, 4, 8, 16,32,10,9,8,7 ILO-2, IHI*8, fcA00*2 0062 

• OUTPUTS - IANS=0# NSUMS=6, MUVSUM< 1 .. .6 )=6, 12,24,48, 42, 1* 0063 
« 0064 
» 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT LADD = 1 0065 
» OUTPUTS - IANS=0^ NSUMS=7, MUVSUM( 1.. .7 ) = 2, 4, 8, 16, 32O0, 9 0066 

• 0067 

• 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT LADD=12 0068 

• OUTPUTS - IANS=1, NSUMS*1, MUVSUM(1)=81 0069 
» 0070 

• 4. INPUTS - SAME AS EXAMPLE 1. EXCEPT IHI=2 0071 
» OUTPUTS - IANS=a*NSUMS=l,MUVSUM( l)=2 0072 

• 0073 

• 5. INPUTS - SAME AS EXAMPLE 1. EXCEPT IHI=2 AND LADD 3 ! 0074 
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PROGRAM LISTINGS 



• 6, 



* 7. 



OUTPUTS - IANS=0* NSUMS=1, MUVSUMtl)=2 

INPUTS - SAME AS EXAMPLE 1. EXCEPT LAD0*7 
OUTPUTS - IANS^O^ NSUMS=1, MUVSUM(1)*81 



INPUTS - SAME AS EXAMPLE 1. EXCEPT IV(2)*131068 (THIS PRODUCES 
• OVERFLOW ON FIRST SUM ONLY SINCE 131068+4*2** 17 ) 

» OUTPUTS- IANS*-2, NSUMS=6, MUVSUM< l...6)=0» 12,24,48142, 19 

» 8* EXAMPLES 8., 9., AND 10, TEST ILLEGALITY CHECKS. 



« INPUTS - SAME AS EXAMPLE 1. 

* OUTPUTS - IANS*-i, NSUMS«0 
• 

» 9. INPUTS 1- SAME AS EXAMPLE 1. 

» OUTPUTS - I ANS*-1, NSUMS^O 
• 

»10. INPUTS - SAME AS EXAMPLE 1. 

• OUTPUTS - I ANS=-i, NSUMS^O 



EXCEPT ILO^O 
EXCEPT IHI=1 
EXCEPT LADD=~50 
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0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 





HTR 


0 




0094 




HTR 


0 




0095 




HTR 


0 




0096 




BCI 


1 , MUVADD 




0097 


MUVADD 


SXD 


MUVADD-4,1 




0098 




SXD 


MUVADD-3,2 




0099 




SXD 


MUV.ADD-2,4 




0100 


* ADDRESS SETUP. 




0101 




CLA 


1,4 




0102 




STA 


IV 




0103 




CLA 


2,4 




0104 




STA 


GET2 




0105 




CLA 


3,4 




0106 




STA 


GET3 




0107 




CLA 


4,4 




0108 




STA 


GET4 




0109 




CLA 


5,4 




0110 




STA 


MUVSUM 




Otll 




CLA 


6,4 




0112 




STA 


PUT6 




0113 




CLA 


7,4 




0114 




STA 


PUT7 




0115 


» INPUT CHANNEL FOR ILO, IHI 


, LADD 


0116 


GET2 


CLA 


•* 


A(ILO) 


0117 




ARS 


18 




0118 




STO 


ILO 




0119 


GET3 


CLA 


• * 


A( IHI) 


0120 




ARS 


18 




0121 




STO 


IHI 




0122 


GET4 


CLA 


«• 


A(LADD) 


0123 




ARS 


18 




0124 




STO 


LADO 




0125 


» CHECK ILO* 


IHI, LADD 




0126 


CK2 


CLA 


ILO 




0127 




CAS 


KO 




0128 




TRA 


CK3 




0129 




NOP 




ILO MUST 


0130 




TRA 


ILEGL 


EXCEED 0 


0131 


CK3 


CLA 


IHI 




0132 




CAS 


ILO 




0133 




NOP 






0134 




TRA 


CK4 


IHI MUST = OR EXCEED ILO. 


0135 




TRA 


ILEGL 




0136 


CK4 


CLA 


LADD 




0137 




CAS 


KO 




0138 




TRA 


STNSM 




0139 




NOP 




LADD MUST 


0140 




TRA 


ILEGL 


EXCEED 0 


0141 



» NOW SET NSUMS AND CHECK IF ZERO OR NEGATIVE, WHICH MEANS LADD 
» LONGER THAN RANGE. 
STNSM CLA IHI 

SUB ILO 

ADD K2 

SUB LADD 

STO NSUMS 

CAS KO 



0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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TRA 


NORML 




0150 


NOP 






0151 


TRA 


SHORT 




0152 


• IF RANGE 


SHORT SET LFRST=LENGTH OF RANGE AND 


NSUMS*1 AND NM@RE*0 AND 


0153 


* 1ANS~1. 






0154 


SHORT CLA 


Kl 




0155 


STO 


NSUMS 




0156 


STO 


I ANS 




0157 


ADD 


IHI 




0158 


SUB 


ILO 




0159 


STO 


LFRST 




0160 


STZ 


NMORE 




0161 


TRA 


SETUP 




0162 


» NORMALLY 


LFRST=LADD» NMORE=NSUMS-l, IANS-0 




0163 


NORML SUB 


Kl 




0164 


STO 


NMORE 




0165 


CLA 


LADD 




0166 


STO 


LFRST 




0167 


STZ 


I ANS 




0168 


TRA 


SETUP 




0169 


» NOW SETUP 


THE TWO L©GPS AND THEN GO TO FIRST 


ONE AFTER TURNING OFF 


0170 


» OVERFLOW 


I F ON, 




0171 


SETUP CLA 


I V 




0172 


SUB 


ILO 




0173 


ADD 


K2 




0174 


STA 


LI ADD 




0175 


STA 


L2SUB 




0176 


SUB 


LADD 




0177 


STA 


L2ADD 




0178 


CLA 


MUVSUM 




0179 


STA 


LiSTO 




0180 


STA 


L2ST0 




0181 


CLA 


NMORE 




0182 


ALS 


18 




0183 


STD 


TXL 




0184 


STD 


L2TXL 




0185 


TOV 


LI 




0186 


TRA 


LI 




0187 


* FIRST LOOP FORMS FIRST SUM. 




0188 


LI LXA 


LFRST, 1 




0189 


CLA 


KO 




0190 


LI ADD ADD 


• ♦♦1 A(IV)-IL0+2 




0191 


TIX 


LI ADD ,1,1 




0192 


* STORE FIRST SUM 




0193 


L1STO STO 


•» A(MUVSUM) 




0194 



» THEN CHECK IF MORE SUMS ARE TO BE DONE (KEEP FIRST IN AC). 0195 
• IF NOT GO CHECK FOR OVERFLOW AND LEAVE. 0196 





LXA 


Kl, 1 


0197 


TXL 


TXL 


L2ADD, 1 ,** **=NMORE 


0198 




TRA 


CKOV 


0199 


• SECOND LOOP 


FORMS REST OF SUMS BY ADDING ONE, SUBTRACTING ONE. 


0200 


L2ADD 


ADD 


♦ *,1 A(IV)-IL0-LA0D+2 


0201 


L2SUB 


SUB 


**,1 A(IV)-lL0+2 


0202 


L2ST0 


STO 


**,1 A (MUVSUM) 


0203 




TXI 


*+i,i,i 


0204 


L2TXL 


TXL 


L2ADD,!,** (NMORE) 


0205 


» WHEN 


DONE* 


GO CHECK OVERFLOW AND LEAVE. 


0206 




TRA 


CKOV 


0207 


* EXIT 


FOR ILLEGAL INPUTS. 


0208 


ILEGL 


CLS 


Kl 


0209 




STO 


IANS 


0210 




STZ 


NSUMS 


0211 




TRA 


LEAVE 


0212 


» CHECK FOR OVERFLOW BEFORE LEAVING. 


0213 


CKOV 


TOV 


OVSET 


0214 




TRA 


LEAVE 


0215 


OVSET 


CLS 


K2 


0216 




STO 


IANS 


0217 




TRA 


LEAVE 


0218 


* STORE IANS, 


NSUMS, AND EXIT. 


0219 


LEAVE 


CLA 


IANS 


0220 




ALS 


18 


0221 


PUT7 


STO 


** A(IANS) 


0222 




CLA 


NSUMS 


0223 




ALS 


18 


0224 
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PUT6 STO 


• * 






A(NSUMS) 


0225 


EXIT LXD 


MUVADD-4, 


1 




0226 


LXD 


MUVAD0-3, 


2 




0227 


LXD 


MUVADD-2, 


4 




0228 


TRA 


8,4 








0229 


* CONSTANTS 










0230 


KO PZE 


0 








0231 


Kl PZE 


1 








0232 


K2 PZE 


2 








0233 


• VARIABLES 










0234 


ILO PZE 


• * 






MUST BE 


0235 


IHI PZE 


•* 






MOVED 


0236 


LADO PZE 


*• 






FROM DECREMENTS 


0237 


NSUMS PZE 


** 






MUST BE MOVED 


0238 


IANS PZE 


** 






TO DECREMENTS. 


0239 


IV PZE 


*# 






»*=A( IV) 


0240 


MUVSUM PZE 


•* 






*«-A<MUVSUM) 


0241 


NMORE PZE 


** 






NSUMS-1 


0242 


LFRST PZE 


»* 






IS NO. OF ELEMENTS IN FIRST SUM. 


0243 


END 










0244 
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MVBLOK { SUBROUTINE) 
FAP 



9/29/64 LAST CARD IN DECK IS NO. 



♦MVBLOK 



COUNT 75 
LBL MVBLOK 

ENTRY MVBLOK (NN, ISORCE, IDEST) 

• ABSTRACT- 

• 

» TITLE - MVBLOK 

* MOVE DATA BLOCK 



« LANGUAGE 

• EQUIPMENT 
» STORAGE 

• SPEED 

• AUTHOR 



MVBLOK MOVES A DATA SERIES FROM ONE AREA IN CORE TO 
ANOTHER AREA. THE TWO AREAS MAY NOT OVERLAP, UNLESS 
THE SOURCE AREA HAS A HIGHER CORE ADDRESS THAN THE 
DESTINATION AREA. 

FAP^ SUBROUTINE ( FORTRAN II COMPATIBLE) 
709 OR 7090 (MAIN FRAME ONLY) 
19 REGISTERS 

28 + 6N MACHINE CYCLES WHERE N^LENGTH OF DATA SERIES. 
S.M. SIMPSON, NOVEMBER, 1961 



USAGE 



« TRANSFER VECTOR CONTAINS ROUTINES - 

• AND FORTRAN SYSTEM ROUTINES - 
* 

• FORTRAN USAGE 

• CALL MVBLOMNN, ISORCE, IDEST) 



NONE 
NONE 



• INPUTS 
» 

• NN 
» 

• ISORCE 

• IDEST 
* 

* 

• OUTPUTS 
« 

* 

* 

• EXAMPLES 



IS THE LENGTH OF THE DATA BLOCK. 
IS FORTRAN II INTEGER. 
MUST BE GRTHN S 1 • 

IS THE CORE ADDRESS OF THE SOURCE DATA BLOCK. 
IS FORTRAN II INTEGER. 

IS THE CORE ADDRESS OF THE DESTINATION DATA BLOCK. 
IS FORTRAN II INTEGER. 



THE CONTENTS OF ISORCE THRU ISORCE-N+l REPLACES THE 
CONTENTS OF IDEST THRU IDEST-N+1. 



LET SORCE AND DEST BE THE TWO DATA AREAS, 
PROGRAMMING SEQUENCE 

ISORCE « XLCCF(SORCE) 

IDEST * XLOCF(DEST) 

CALL MVBLOK (NN, ISORCE, IDEST) 

IS EQUIVALENT TO 



THEN THE 



10 



DO 10 1=1, NN 
J = NN-I+1 
DEST(J) = SCRCE(J) 



0082 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 



HTR 


0 




0063 


BCI 


1 , MVBLOK 




0064 


MVBLOK SXD 


*-2,4 




0065 


CLA* 


2,4 




0066 


ARS 


18 




0067 


ADD 


Kl 


ISRCE+1 


0068 


STA 


MOV 




0069 


CLA* 


3,4 




0070 


ARS 


18 




0071 


ADD 


Kl 


IDST+1 


0072 


STA 


MOV + 1 




0073 


CLA* 


1,4 


N 


0074 
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POX 


0,4 


TO XR4 


0075 


CLA 


»#,4 


**=ISRCE+i 


0076 


STO 


• *,4 


«*=IDST+1 


0077 


TIX 


MOV, 4,1 




0078 


LXO 


MV8LCK-2,4 




0079 


TRA 


4,4 




0080 


PZE 


1 




0081 


END 






0082 
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» MVINAV ISUBRGUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0115 

« LABEL 0001 

CMVINAV 0002 

SUBROUTINE MVINAV (REC,LREC,K, RECAV, IANS) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - MVINAV 0007 

C MOVING AVERAGE OF A VECTOR 0008 

C 0009 

C MVINAV FINDS THE MOVING AVERAGE, RECAV(I), OF 0010 

C A FLOATING POINT VECTOR, RECU) 1 = 1,*.., LREC , ACCORDING 0011 

C TO THE EQUATION 0012 

C 0013 

C 1 I+K 0014 

C RECAV(I) = SUM ( REC (J) ) 0015 

C 2K+1 J=I-K 0016 

C 0017 

C FOR I = 1,2,...,LREC 0018 

C WHERE K AND LREC ARE INPUT PARAMETERS* 0019 

C AND THE COMPUTATIONS ARE MADE AS THOUGH REC131 0020 
C WERE ZERO FOR J LESS THAN 1 AND GREATER THAN LREC 0021 

C 0022 

C LANGUAGE - FORTRAN II SUBROUTINE 0023 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0024 

C STORAGE - 221 REGISTERS 0025 

C SPEED - 65*LREC MACHINE CYCLES FOR LARGE LREC 0026 

C AUTHOR - S.M. SIMPSON, MARCH 1963 0027 

C 0028 

C ——USAGE 0029 

C 0030 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0031 

C AND FORTRAN SYSTEM ROUTINES - NONE 0032 

C 0033 

C FORTRAN USAGE 0034 

C CALL MVINAV(REC#LREC,K, RECAV, IANS) 0035 

C 0036 

C INPUTS 0037 

C 0038 

C RECU) 1 = 1, LREC IS A FLOATING POINT VECTOR 0039 

C 0040 

C LREC MUST EXCEED ZERO 0041 

C 0042 

C K SPECIFIES THE AVERAGING LENGTH AS 2K + 1 POINTS 0043 

C MUST BE NON-NEGATIVE, AND 0044 

C 2*K+1 MUST BE LESS THAN LREC 1UNLESS K=0» 0045 

C 0046 

C OUTPUTS 0047 

C 0048 

C RECAV(I) I=1,...,LREC IS THE MOVING AVERAGE GIVEN IN ABSTRACT 0049 

C 0050 

C IANS = 0 NORMALLY 0051 

C * -2 FOR ILLEGAL LREC (NO OTHER OUTPUT IN THIS CASE) 0052 

C = -3 FOR ILLEGAL K (NO OTHER OUTPUT IN THIS CASE! 0053 

C 0054 

C 0055 

C EXAMPLES 0056 

C 0057 

C 1. INPUTS - REC(1.#.6) « 9. ,9. ,0., 36., 36. ,9. 0058 

C LREC=6 K1=0 K2=i K3=2 0059 

C USAGE - CALL MV I NAV ( REC, LREC , Kl , REC AV I, I ANSI ) 0060 

C CALL MVINAV( REC, LREC, K2,RECAV2, IANS2) 0061 

C CALL MVINAV( REC, LREC, K3,RECAV3, IANS3) 0062 

C OUTPUTS - IANS1=0 RECAV I ( 1. . .6) = 9., 9. ,0. , 36., 36. ,9. 0063 

C IANS2=0 RECAV2U...6) * 6 . , 6. , 15. , 24. , 27. , 15. 0064 

C IANS3=0 RECAV3( 1...6) « 3.6, 10.8, 18., 18. , 16.2, 16.2 0065 

C 2. ILLEGAL CASES 0066 

C USAGE - CALL MV I NAV ( REC, 0 ,0 , RECAV, IANS 1 ) 0067 

C CALL MVINAV( REC, 3,-1, RECAV, IANS2) 0068 

C CALL MVINAV ( REC, 7, 3, RECAV, IANS3) 0069 

C OUTPUTS - IANS1 =* -2 (ILLEGAL LREC) 0070 

C IANS2 * IANS3 = -3 (ILLEGAL K) 0071 

C 0072 

C DUMMY DIMENSIONS 0073 

DIMENSION REC(2),RECAV(2) 0074 
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C CHECK INPUTS. LREC GRTHN O f K GRTHN=0, 2*K + 1 LSTHN LREC 0075 

IANS=-2 0076 

IF ( LREC) 9999,9999,10 0077 

10 IANS=-3 0078 

IF(K) 9999,30,20 0079 

20 IF(2»K+1~LREC) 40,9999,9999 0080 

C SPECIAL TREATMENT FOR K=0 0081 

30 IANS=0 0082 

DO 35 1=1, LREC 0083 

35 RECAVU)=RECm 0084 

GO TO 9999 0085 

C TREAT LEFT EDGE EFFECT - SET RECAV ( 1* • *K+ 1 } 0086 

C FIRST SET RECAVil) 0087 

40 IANS=0 0088 

LEND-K+l 0089 

RECAVC1)=0. 0090 

DO 50 1=1, LEND 0091 

50 RECAVU)=RECAVU>+REC(I) 0092 

C THEN SET RECAV( 2.. .K+l ) 0093 

DO 60 1=2, LEND 0094 

IADD=I+K 0095 

60 RECAVU)=RECAV( I-i)+REC( I ADD) 0096 

C NOW TREAT CENTRAL TERMS - SET RECAV ( K+2, LREC-K ) 0097 

IXL0=LEND+1 0098 

IXHI=LREC-K 0099 

DO 70 I=IXLO,IXHI 0100 

IADD=H-K 0101 

ISUB=I-LEND 0102 

70 RECAVf I)=RECAV( I-1)+REC( IADD)-REC( ISUB) 0103 

C NEXT TREAT RIGHT ED€E EFFECT - SET RECAV f LREC-K + 1, i , LREC I 0104 

IXL0=LRECHU1 0105 

DO 80 I=IXL0,LREC 0106 

ISUB=I-LEND 0107 

80 RECAVU)=RECAV( 1-1 )-REC( ISUB) 0108 

C FINALLY AVERAGE THE RESULT 0109 

SCALE»l./FL0ATFt2»K*l) 0110 

DO 90 1=1, LREC 0111 

90 RECAV(I)=RECAV(1)*SCALE 0112 

C EXIT 0113 

9999 RETURN 0114 

END 0115 
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» MVNSUM (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO* 0201 

» FAP 0001 

•MVNSUM 0002 

COUNT 250 0003 

LBL MVNSUM 0004 

ENTRY MVNSUM (X, LX, LSUM, DVSR, SUMOVD, LSUMOD) 0005 

• 0006 

• 0007 

• ABSTRACT 0008 

• 0009 

• TITLE - MVNSUM 0010 
« MOVING SUMMATION WITH DIVISION BY A CONSTANT 0011 

• 0012 
» MVNSUM COMPUTES 0013 
» 0014 

• 1 I+L-l 0015 

• S(I> = SUM X(J) , I » 1,2,...,N=LX-L+1 0016 

« D J=I 0017 

» 0018 

• GIVEN X(H..LX), LX, L, AND D. 0019 

• 0020 
» COMPUTATIONS ARE SPED UP FOR D * 1.0 . THE OUTPUT VECTOR 0021 
» MAY REPLACE THE INPUT VECTOR, THE LENGTH N IS AN 0022 
« ADDITIONAL OUTPUT. 0023 

• 0024 
» LANGUAGE - FAP SUBROUTINE ( FORTRAN— 1 1 COMPATIBLE) 0025 

• EQUIPMENT - 709,7090,7094 (MAIN FRAME ONLY) 0026 

• STORAGE - 71 REGISTERS 0027 
« SPEED - ON THE 7090, MVNSUM TAKES 0028 
» 78.6 ♦ 8.4*L ♦ 22.8*N MACHINE CYCLES IF D * 1.0 0029 

• 74.6 + 8.4*L + 39.8*N MACHINE CYCLES IF D NOT* 1*0 0030 

• WHERE L, N AND D ARE DEFINED ABOVE. 0031 
« AUTHOR - S.M. SIMPSON, JULY 1964 0032 
« 0033 

• 0034 

• USAGE — — 0035 

» 0036 

» TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0037 

• AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0038 

• 0039 
» FORTRAN USAGE 0040 

• CALL MVNSUMCX, LX, LSUM, DVSR, SUMOVD, LSUMOD) 0041 
» 0042 

• 0043 

• INPUTS 0044 
» 0045 

• X(I) 1=1. ..LX IS A FLOATING POINT VECTOR. 0046 
» 0047 

• LX MUST EXCEED ZERO. 0048 
» 0049 
» LSUM IS THE SUMMING LENGTH, L OF THE ABSTRACT. 0050 

• MUST EXCEED ZERO AND BE LSTHN= LX. 0051 
» 0052 

• DVSR IS THE DIVISOR, D, OF THE ABSTRACT. 0053 

• MUST Bf NON-ZERO. 0054 
» 0055 

• 0056 
» OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LX, LSUM, OR DVSR 0057 

• ILLEGAL. 0058 

• 0059 
» SUMOVDU) 1*1. ..LSUMOD IS THE MOVING SUM SU...N) OF THE 0060 
» ABSTRACT. 0061 
» 0062 

• LSUMOD WILL * LX-LSUM+l . 0063 
» 0064 
» 0065 

• 0066 

• EXAMPLES 0067 

• 0068 

• 1. UNITY DIVISOR CASES 0069 
» INPUTS - XU...3) = l.,2.,4. DVSR * 1.0 0070 
» S(i...3,1...3,1...3) = -9.,-9.,... 0071 

• LSI l..*3, 1...3) * -9,-9,... 0072 
» USAGE - DO 10 LX=1,3 0073 

• DO 10 LSUM=1,1X 0074 
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10 CALL MVNSUM(X,LX,LSUM, DVSR, S ( 1 ,LSUM, LX), 
I LS(LSUM,LX)) 
OUTPUTS - SU.. .3,1.. .3,1) - l.,-9,,-9. f ,-9.»-9«t-9,»*-9.,-9*»-9. 

S(1...3,1...3,2) = 1., 2. ,-9.,* 3.,-9.,-9.#*-9.,-9.,~9. 
S( l.».3,1...3,3) = 1. * 2., 4.,, 3., 6.»-9.# r 7. ,-9*, -9. 
LSU...3, 1...3) = 1,-9,-9, ,2, 1,-9, ,3,2,1 



• 2. 



• 3, 



* 4. 



NON-UNITY DIVISOR CASES 
INPUTS - SAME AS EXAMPLE 
USAGE - SAME AS EXAMPLE 
OUTPUTS - SAME AS EXAMPLE 
NOT EQUAL -9, 



1. EXCEPT DVSR = 0.5 
1. 

1. EXCEPT THAT ALL VALUES OF 
WILL BE DOUBLED* 



S WHICH DO 



CASE WHERE OUTPUT REPLACES INPUT 
INPUTS - SAME AS EXAMPLE 1. 

USAGE - CALL MVNSUM( X, 3, 2,0VSR,X, LSUMOD* 

OUTPUTS - XU...3) * 3.,6.,4. LSUMOD = 2 

ILLEGAL USAGES 

INPUTS - SAME AS EXAMPLE 1. 

USAGE - CALL MVNSUM(X,0, 2,1.0,S,LS) 

CALL MVNSUM(X, 2,-1, 1.0,S,LS) 
CALL MVNSUM(X,2, 3,l.0,S,LS) 
CALL MVNSUM(X,3, 2,0.0, S,LS) 

OUTPUTS - S * -9. LS » -9 



* PROGRAM FOLLOWS BELOW 

* NO TRANSFER VECTOR 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 



HTR 


0 


XR4 


0106 


BCI 


1 , MVNSUM 




0107 


* 






0108 


• ONLY ENTRY. 


MVNSUMCXr 


LX, LSUM, DVSR, SUMOVD, LSUMOD) 


0109 


• 






0110 


MVNSUM SXD 


MVNSUM-2,4 




0111 


« 






0112 


• CHECK OUT 


LSUM,' DVSR, 


LX. SET LSUMOD. 


0113 


• 






0114 


CLA* 


3,4 


LSUM 


0115 


ARS 


18 


IN ADDRESS 


0116 


TMI 


LEAVE 




0117 


TZE 


LEAVE 




0118 


STO 


LSUM 


STORED 


0119 


CLA* 


4,4 


DVSR 


0120 


STO 


DVSR 




0121 


TZE 


LEAVE 




0122 


FSB 


K1L 


SET SWITCH 


0123 


STO 


ZFDl 


FOR DVSR = 1.0 


0124 


CLA» 


2,4 


LX 


0125 


TMI 


LEAVE 




0126 


TZE 


LEAVE 




0127 


SUB* 


3,4 


LX-LSUM 


0128 


ADD 


KD1 


LX-LSUM+1 = LSUMOD 


0129 


TMI 


LEAVE 




0130 


TZE 


LEAVE 




0131 


STO* 


6,4 


LSUMOD STORED 


0132 


STD 


TXL1 




0133 


STD 


TXL2 




0134 


• 






0135 


* THEN SET ADDRESSES AND 


DVSR 


0136 


• 






0137 


CLA 


1,4 


A(X) 


0138 


ADO 


Kl 


A(X)*1 


0139 


STA 


FAD1 




0140 


STA 


LDQ1 




0141 


STA 


LDQ2 




0142 


ADD 


Kl 


A(X)+2 


0143 


SUB 


LSUM 


ACXK2-LSUM 


0144 


STA 


FAD2 




0145 


STA 


FAD3 




0146 


CLA 


5,4 


A(SUMOVD) 


0147 


ADD 


Kl 


A(SUM0VD)+1 


0148 


STA 


STO 




0149 
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STA 


STQ 




0150 
0151 


FORM 


X(LSUM)+XCLSUM-1>+... 


♦ XU>, THEN BRANCH TO PROPER LOOP 


0152 










0153 




LXA 


LSUM, 4 


LSUM TO XR4 


0154 




PXD 


0,0 


ZERO TO AC 


0155 


FADl 


FAD 


**,4 


«• s AtX)+l 


0156 




TIX 


FADl, 4,1 




0157 




ZET 


ZFD1 


(NOTE XR4 IS NOW * 1) 


0158 




TRA 


LDQ2 




0159 




TRA 


LDQi 




0160 
0161 


> LOOP 


WITHOUT DIVISION 




0162 










0163 


FAD2 


FAD 


** t 4 


** * A|X)+2~LSUM 


0164 




FSB 


LEND 




0165 


LDQ1 


LDQ 


• * t 4 


«* « A(X)*1 


0166 




STQ 


LEND 


(SET ASIDE LEFT END ELEMENT) 


0167 


STO 


STO 


»* f 4 


** - A(SUM0VD)+1 


0168 




TXI 


•+1,4,1 




0169 


TXL1 


TXL 


FAD2,4,«* 


** « LX-LSUM+1 = LSUMOD 


0170 




TRA 


LEAVE 




0171 
0172 


LOOP 


WITH 


DIVISION BY DVSR 




0173 
0174 


CLA 


CLA 


TEMP 




0175 


FAD3 


FAD 


**,4 


*♦ * A(X)+2-LSUM 


0176 




FSB 


LEND 




0177 


L0Q2 


LDQ 


** *4 


** = A(X)+l 


0178 




STQ 


LEND 




0179 




STO 


TEMP 




0180 




FDP 


DVSR 




0181 


STQ 


STQ 


»* ,4 


** * A(SUM0VD)+1 


0182 




TXI 


*+l,4,I 




0183 


TXL2 


TXL 


CLA, 4, #* 


** - LX-LSUM+1 « LSUMOD 


0184 
0185 


EXIT 








0186 
0187 


LEAVE 


LXD 


MVNSUM-2,4 




0188 




TRA 


7,4 




0189 
0190 


► CONSTANTS, 


TEMPORARIES 




0191 










0192 


ki 


PZE 


1 




0193 


KOI 


PZE 


0,0,1 




0194 


KIL 


DEC 


1.0 




0195 


LSUM 


PZE 


♦♦,0,0 


** * LSUM 


0196 


DVSR 


PZE 


#» 


INPUT DVSR 


0197 


TEMP 


PZE 


«*,«*,#« 




0198 


LEND 


PZE 


»*,«*, #« 


X(l),X(2),... 


0199 


ZFD1 


PZE 
END 


** t *«, ft* 


= 0.0 IF DVSR * 1.0, NOT * 0.0 OTHERWISE 


0200 
0201 
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MVNTIN (SUBROUTINE! 9/4/64 LAST CARD IN DECK IS NO. 0233 



• 


FAP 




0001 


♦MVNTIN 




0002 




COUNT 


250 


0003 




L8L 


MVNTIN 


0004 




ENTRY 


MVNTIN (X, LX, DEL, LINT, XMI, LXMI) 


0005 




ENTRY 


MVNTNA IX, LX, DEL, LINT, XAMI, LXAMI) 


0006 


• 






0007 


* 






0008 


• 




— — ABSTRACT 


0009 


• 






0010 


* 


TITLE - MVNTIN, WITH SECONDARY ENTRY MVNTNA 


001 1 


» 


MOVING TRAPE20IDAL INTEGRAL OR ABSOLUTE VALUE INTEGRAL 


0012 


• 






0013 


* 




MVNTIN COMPUTES 


0014 


* 






0015 


• 




X(I) I+LINT-2 X ( I+L INT-11 


0016 


• 




XMICI) * DEL « ( ♦ SUM X< J) ♦ — — ) 


0017 


• 




2 J*I*1 2 


0018 


* 






0019 


* 




FOR I * i,2,...,LXMI=LX-LINT+l 


0020 


* 






0021 


* 




GIVEN THE VECTOR X11...LX), THE LENGTH LX, THE 


0022 


• 




INCREMENT DEL, AND THE INTEGRATING LENGTH LINT* THE 


0023 


• 




LENGTH* LXMI, OF THE MOVING INTEGRAL IS AN ADDITIONAL 


0024 


* 




OUTPUT. THE OUTPUT VECTOR MAY REPLACE THE INP^T VECTOR. 


0025 


• 






0026 


* 




MVNTNA COMPUTES THE SAME EXPRESSION AS DOES MVNTIN 


0027 


• 




EXCEPT THAT THE MAGNITUDES OF THE XI I ) VALUES ARE USED* 


0028 


• 






0029 


• 






0030 


* 


LANGUAGE 


- FAP SUBROUTINES { FORTRAN- I I COMPATIBLE) 


0031 


• 


EQUIPMENT 


- 709,7090,7094 (MAIN FRAME ONLY) 


0032 


• 


STORAGE 


- 88 REGISTERS 


0033 


* 


SPEED 


- ON THE 7090 EITHER ENTRY TAKES ABOUT 


0034 


• 




50 * 18*8»LINT ♦ 52.6*LXMI MACHINE CYCLES 


0035 


• 


AUTHOR 


- S.M. SIMPSON, AUGUST 1964 


0036 


* 






0037 


• 






0038 


• 




USAGE >- 


0039 


• 






0040 


• 


TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 


0041 


• 


AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 


0042 


• 






0043 


* 


FORTRAN USAGE 


0044 


• 


CALL MVNTINIX, LX, DEL, LINT, XMI, LXMI) 


0045 


• 


CALL MVNTNAC X, LX, DEL, LINT, XAMI, LX AMI ) 


0046 


• 






0047 


• 


INPUTS 




0048 


• 






0049 


• 


xm 


I«1...LX IS THE VECTOR TO BE INTEGRATED. 


0050 


♦ 






0051 


• 


LX 


MUST BE GRTHN= 2 . 


0052 


• 






0053 


• 


DEL 


IS THE INCREMENT BETWEEN X(I) VALUES. MAY BE NEGATIVE 


0054 


* 




OR 2ER0. 


0055 


• 






0056 


• 


LINT 


IS THE INTEGRATING LENGTH. 


0057 


• 




MUST BE GRTHN= 2 AND LSTHN* LX. 


0058 


• 






0059 


• 






0060 


• 


OUTPUTS 


STRAIGHT RETURN WITH NO OUTPUTS IF LX OR LINT 


0061 


» 




IS ILLEGAL. 


0062 


• 






0063 


• 


XMI(I) 


1*1.. .LXMI IS OUTPUT FROM MVNTIN AS GIVEN IN ABSTRACT. 


0064 


• 




EQUIVALENCE IX, XMI) IS PERMITTED. 


0065 


• 






0066 




LXMI 


* LX-tINT+1 IS OUTPUT FROM MVNTIN. 


0067 


• 




EQUIVALENCE (LX,LXMI) IS PERMITTED. 


0068 


• 






0069 


• 


XAMI (I) 


1=1.*. LXAMI IS OUTPUT FROM MVNTNA AS GIVEN IN 


0070 


• 




ABSTRACT. EQUIVALENCE (LX, LXAMI) IS PERMITTED. 


0071 


» 






0072 


• 


LXAMI 


* LX-LINT+1 IS OUTPUT FROM MVNTNA. 


0073 
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EQUIVALENCE UX, LXAMI) IS PERMITTED, 



EXAMPLES 



• 1. 



TESTING EXTREMAL VALUES OF 
INPUTS 



USAGE 



OUTPUTS - 



LX, LINT (INCLUDING ILLEGAL VALUES) 
X(l.*.4) » -l.,2.,-4.,8. DEL * 2.0 

XMI (1...3,1...4, 1 4) » XAMK 1. • .3, 1*. .4, 1. ..4) 

* -99. ,-99,, ... 
LXMH 1...4,1...4) « LXAMI(1*..4, 1...4) * -9 f -9#..« 
DO 10 LX=1,4 
DO 10 LI=i,4 

CALL MVNT I N ( X , LX » DEL , L I , XMHl»LltLXI, LXM I CL I ,LX1 1 
CALL MVNTNAU, LX , DEL *L I , XAMI < 1*L I , LX1 , LXAMHLf t LX1J 
XMI VALUES = -99. AND ALL LXMI VALUES = -9 
EXCEPT AS FOLLOWS, 

XMl(l...l,2,2) = 1.0 LXM 1(2,2) 

1.0,-2.0 LXMU2#3) 
-1.0 LXMIC3»3) 
1.0,-2.0,4.0 LXM I ( 2,4) 

-1.0, 2.0 LXMH3»4) 
3.0 LXMI(4,4) 



10 
ALL 



XMI(1...2,2,3) 
XMI(1...1,3,3) 
XMH1...3,2,4) 
XMI U. ..2, 3, 4) 
XMIU... 1,4,4) 



ALL XAMl VALUES * -99. AND ALL LXAMI VALUES * -9 
EXCEPT AS FOLLOWS. 



XAMK 1... 1,2,2) 
XAMIU...2,2,3) 
XAMK I.. .1,3, 3) 
XAMI<1...3,2,4) 
XAM H 1. • • 2, 3, 4) 
XAMK 1... 1,4,4) 



= 3.0 

■ 3.0,6.0 

= 9.0 

3.0,6.0,12.0 
= 9.0,18.0 
= 21.0 



LXAMI(2,2) 
LXAMI(2,3) 
LXAMH3,3) 
LXAMI (2,4) 
LXAMI(3,4) 
LXAMI(4,4) 



2. CASE WHERE OUTPUTS REPLACE INPUTS 

INPUTS - SAME AS EXAMPLE 1. EXCEPT LX = 4 
USAGE - CALL MVNT IN( X , LX, DEL , 2,X, LX ) 

OUTPUTS - XU...4) » 1.0, -2. 0,4. 0,8. LX 



♦ PROGRAM FOLLOWS BELOW 

• NO TRANSFER VECTOR 
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0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 





HTR 


0 


XR4 


0115 




BCI 


1, MVNT IN 




0116 


• 








0117 


• FIRST ENTRY. 


MVNTINIX, LX 


, DEL, LINT, XMI, LXMI) 


0118 


• 








0119 


MVNTIN 


CLA 


FAD4 


CHOOSE INSTRUCTIONS 


0120 




LDQ 


FSB4 


FOR SIGNED ADDITION, SUBTRACTION. 


0121 




TRA 


MERGE 




0122 


* 








0123 


• SECOND ENTRY 


. MVNTNA(X,LX, 


DEL, LINT, XAMI, LXAMI) 


0124 


• 








0125 


MVNTNA 


CLA 


FAM4 


CHOOSE ABSOLUTE VALUE 


0126 




LDQ 


FSM4 


INSTRUCTIONS. 


0127 


MERGE 


SXD 


MVNTIN-2,4 




0128 




STO 


FAZ 




0129 




STO 


FA1 




0130 




STO 


FA2 




0131 




STQ 


FS1 




0132 




STQ 


FS2 




0133 


• 








0134 


♦ SET 


DEL/2.0 


, CHECK LX, 


LINT. 


0135 


* 








0136 




CLA» 


3,4 


DEL 


0137 




FDP 


K2L 


DEL/2.0 


0138 




STQ 


DELHAF 




0139 




CLA* 


2,4 


LX 


0140 




CAS 


KD1 




0141 




TRA 


LXOK 


MUST EXCEED 1 


0142 




TRA 


LEAVE 




0143 




TRA 


LEAVE 




0144 


LXOK 


CLA» 


4,4 


LINT 


0145 




SUB 


KD1 


LINT-i 


0146 




TMl 


LEAVE 


CHECK FOR 


0147 




TZE 


LEAVE 


UNDERSIZED LINT 


0148 
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STO 


TXL1 






0149 


SUB» 


2,4 


LINT-l-LX 




0150 


CHS 




LX-LINT+1 » LXMI 




0151 


TMI 


LEAVE 


CHECK FOR 




0152 


TZE 


LEAVE 


OVERSIZEO LINT 




0153 
0154 


» INPUTS OK. 

► 








0155 
0156 


STO* 


6,4 


LXMI STOREO 




0157 


STO 


TXL3 






0158 


SUB 


KD1 


LXMI-1 




0159 


STD 


TXL2 






0160 


CLA» 


4,4 


LINT 




0161 


ARS 


18 






0162 


STO 


LINT 






0163 


CLA 


1,4 


A(X) 




0164 


STA 


FS2 






0165 


AOD 


Ki 


A(X)+1 




0166 


STA 


FAZ 






0167 


STA 


FS1 






0168 


SUB 


LINT 


A(X)+1-LINT 




0169 


STA 


FA2 






0170 


A 00 


Kl 


A(X)+2-LINT 




0171 


STA 


FAI 






0172 


CLA 


5,4 


A(XMI) 




0173 


AOO 


Kl 


A(XMI)+1 




0174 


STA 


STO 






0175 
0176 


► START COMPUTATIONS BY 


FORMING 




0177 


t 


sm * 


X(l) + 2«X(2) ♦ ... ♦ 2«X(LINT~1) ♦ XCLINTI, 


0178 


► AVOIDING MIOOLE TERMS 


IF LINT * 2* AND STORE IN SLAST. 


0179 










0180 


AXT 


1,4 


XR4 = I = 1...LINT 




0181 


PXD 


0,0 






0182 


FAZ NOP 




FAD (FAM) «« t 4 •» * 


A(X)+1 


0183 


TXI 


TXL1,4,1 






0184 


XEC XEC 


FAZ 






0185 


XEC 


FAZ 






0186 


TXI 


•♦1,4,1 






0187 


TXL1 TXL 


XEC,4,#« 


•• « LINT-1 




0188 


XEC 


FAZ 






0189 


STO 


SLAST 






0190 
0191 


> MAIN LOOP 


FORMS SUil) 


» S( I)-X( I)-X( I + D+XC I*LINT-1)+X( I+L1NT1 


0192 






* SNEXT 




0193 


* SETS 


XMHIJ = (DEL/2. 0)»SLAST 




0194 


► SETS 


SLAST » SNEXT 




0195 


► (NOTE FORMULA IS OK FOR LINT = 2) 




0196 










0197 


AXT 


0,4 






0198 


TRA 


TXI2 






0199 


CLA CLA 


SLAST 


U OF ABOVE FORMULA IS 


NOW IN XR4) 


0200 


FS1 NOP 




FSB (FSM) *»,4 ♦♦ = 


A(X)+1 


0201 


FS2 NOP 




FSB (FSM) «,4 *• = 


A(X) 


0202 


FAi NOP 




FAD (FAM) «« t 4 «♦ * 


A(X)+2-LINT 


0203 


FA2 NOP 




FAD (FAM) «»,4 •• « 


A(X)+l-LINT 


0204 


STO 


SNEXT 






0205 


LDQ LOQ 


SLAST 






0206 


FMP 


DELHAF 






0207 


STO STO 


*»,4 


*« a A(XMI)+1 




0208 


CLA 


SNEXT 






0209 


STO 


SLAST 






0210 


TXI2 TXI 


•+1,4,1 


XR4 = l,2,...,LXMI+l 




0211 


TXL2 TXL 


CLA,4,*» 


»• * LXMI-1 




0212 


TXL3 TXL 


LDQ,4,#« 


•» = LXMI (AVOIDS FORMING SfLXMf*lll 


0213 










0214 


> EXIT 








0215 
0216 


LEAVE LXD 


MVNTIN-2, 


4 




0217 


TRA 


7,4 






0218 
0219 


> CONSTANTS, 


TEMPORARIES 






0220 
0221 


Kl PZE 


1 






0222 


KOI PZE 


0,0,1 






0223 
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K2L OEC 2.0 0224 

FA04 FAD **#4 0225 

FSB4 FSB **#4 0226 

FAM4 F AM **,4 0227 

FSM4 FSM *«,4 0228 

LINT PZE **#0,0 • * * LINT 0229 

DELHAF PZE **,»*,#* DEL/2,0 0230 

SNEXT PZE #»,**,#• S(I+1) I«l,2t...,LXMI-l 0231 

SLAST PZE **,»#,#* S(I) 1=1,2,..., LXMI 0232 

END 0233 



« MVNTNA * 
♦»#*»»»***»*»#*#•»#»**#» 

REFER TO 

MVNTIN 
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• MVSQAV ( SUBROUTINE ) 9/29/64 LAST CARD IN DECK IS NO. 0115 

* LABEL 0001 
CMVSQAV 0002 

SUBROUTINE MVSQAV (REC, LREC, K, RECAV, IANS) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - MVSQAV 0007 

C WOVING MEAN SQUARE AVERAGE OF A VECTOR 0008 

C 0009 

C MVSQAV FINDS THE MOVING SQUARE AVERAGEt RECAVUlt OF 0010 

C A FLOATING POINT VECTOR, REC(I) 1=1, **• ,LREC, ACCORDING 0011 

C TO THE EQUATION 0012 

C 0013 

C 1 I*K 2 0014 

C RECAVU) * SUM < REC (J) ) 0015 

C 2K+1 J=I-K 0016 

C 0017 

C FOR I = 1,2,...,LREC 0018 

C WHERE K AND LREC ARE INPUT PARAMETERS! 0019 

C AND THE COMPUTATIONS ARE MADE AS THOUGH REC (J! 0020 
C WERE ZERO FOR J LESS THAN 1 AND GREATER THAN LREC 0021 

C 0022 

C LANGUAGE -* FORTRAN II SUBROUTINE 0023 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0024 

C STORAGE - 236 REGISTERS 0025 

C SPEED - 97«LREC MACHINE CYCLES FOR LARGE LREC 0026 

C AUTHOR - S.M. SIMPSON, MARCH 1963 0027 

C 0028 

C —USAGE 0029 

C 0030 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0031 

C AND FORTRAN SYSTEM ROUTINES - NONE 0032 

C 0033 

C FORTRAN USAGE 0034 

C CALL MVSQAV(REC^LREC,K, RECAV, IANS) 0035 

C 0036 

C INPUTS 0037 

C 0038 

C REC(I) 1=1 ». . • ,LREC IS A FLOATING POINT VECTOR 0039 

C 0040 

C LREC MUST EXCEED ZERO 0041 

C 0042 

C K SPECIFIES THE AVERAGING LENGTH AS 2K+1 POINTS 0043 

C MUST BE NON-NEGATIVE, AND 0044 

C 2*K+1 MUST BE LESS THAN LREC (UNLESS K*0» 0045 

C 0046 

C OUTPUTS 0047 

C 0048 

C RECAVU) 1 = 1, LREC IS THE MOVING AVERAGE GIVEN IN ABSTRACT 0049 

C 0050 

C IANS = 0 NORMALLY 0051 

C = -2 FOR ILLEGAL LREC (NO OTHER OUTPUT IN THIS CASE! 0052 

C « -3 FOR ILLEGAL K (NO OTHER OUTPUT IN THIS CASE} 0053 

C 0054 

C 0055 

C EXAMPLES 0056 

C 0057 

C 1* INPUTS - RECU...6) = 3. ,-3, , 0, , 6. ,-6. , 3* 0058 

C LREC=6 K1=0 K2*l K3=2 0059 

C USAGE - CALL MVSQAV ( REC,LREC,K1,RECAV1, IANS 11 0060 

C CALL MVSQAV(REC,LREC,K2,RECAV2, IANS2* 0061 

C CALL MVSQAV(REC»LREC,K3,RECAV3,IANS3J 0062 

C OUTPUTS - IANS1=0 RECAV1 ( 1 . . .6) * 9 •, 9. , 0. , 36. , 36. ,9. 0063 

C IANS2=0 RECAV2( 1...6) « 6 6. , 15. , 24. * 27. » 15. 0064 

C IANS3=0 RECAV3U...6) = 3.6, 10.8, 18., 18., 16.2*16.2 0065 

C 2. ILLEGAL CASES 0066 

C USAGE - CALL MVSQAV(REC, 0,0, RECAV, IANS1) 0067 

C CALL MVSQAV( REC, 3,-1, RFCAV, IANS2) 0068 

C CALL MVSQAV ( REC, 7, 3, RECAV, IANS3) 0069 

C OUTPUTS - IANS1 * -2 (ILLEGAL LREC) 0070 

C IANS2 * IANS3 = -3 (ILLEGAL K) 0071 

C 0072 

C DUMMY DIMENSIONS 0073 

DIMENSION REC(2),RECAV(2) 0074 
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C CHECK INPUTS. LREC GRTHN 0, K GRTHN=0, 2»K+i LSTHN LREC 0075 

I ANS=-2 0076 

IF(LREC) 9999,9999,10 0077 

10 IANS—3 0078 

IFtK) 9999,30,20 0079 

20 IFt2»K+l-LREC) 40,9999,9999 0080 

C SPECIAL TREATMENT FOR K*0 0081 

30 IANS=0 0082 

DO 35 1*1, LREC 0083 

35 RECAVtI)=REC(I)*RECCI) 0084 

GO TO 9999 0085 

C TREAT LEFT EDGE EFFECT - SET RECAVt 1** *K+1 ) 0086 

C FIRST SET RECAVtl) 0087 

40 IANS«0 0088 

LEND=K+1 0089 

RECAV(1)=0. 0090 

DO 50 I«1,LEND 0091 

50 RECAVtl)=RECAV<l)+RECU)»RECU) 0092 

C THEN SET RECAVC2.. .K+l ) 0093 

DO 60 1=2, LEND 0094 

IADD^I+K 0095 

60 RECAVt I) =RECAV< I-l)+RECt IADD)«REC( I ADD) 0096 

C NOW TREAT CENTRAL Tf RMS - SET RECAVt K+2, ,LREC-K) 0097 

IXLO=LEND+l 0098 

IXHI=LREC-K 0099 

DO 70 I«IXLO,IXHI 0100 

IAOD*I+K 0101 

ISUB=I-LEND 0102 

70 RECAVt I) =RECAV{ 1-1) + RECU ADD) *REC< IADD)-RECt ISUB)»RECI ISUB* 0103 

C NEXT TREAT RIGHT EDGE EFFECT - SET RECAV I LREC-K+1, LREC) 0104 

IXLO=LREC-K*l 0105 

DO 80 I=IXLO,LREC 0106 

ISUB*I-LEND 0107 

80 RECAVt I )=RE€AV(I-1)-REC{ ISUB)«RECt ISUB) 0108 

C FINALLY AVERAGE THE RESULT 0109 

SCALE=1./FL0ATF(2»K+1) 0110 

DO 90 1*1, LREC 0111 

90 RECAVt I ) =RECAV ( 1 ) *SCALE 0112 

C EXIT 0113 

9999 RETURN 0114 

END 0115 
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» MXRARE (SUBROUTINE) 9/29/64 LAST CARO IN DECK IS NO* 0249 

• LABEL 0001 

CMXRARE 0002 
SUBROUTINE MXRARE ( ON, DD, LD, DNFRAC, DDFRAC, MNREWI ,RAMX, ILO, IHI ,! ANSI 0003 

C 0004 

C —i — ABSTRACT 0005 

C 0006 

C TITLE - MXRARE 0007 

C FINDS REGION TO MAXIMIZE RATIO OF TWO DISTRIBUTION FUNCTIONS 0008 

C 0009 

C MXRARE FINDS A REGION (SUBJECT TO CONSTRAINTS), IN TERMS 0010 

C OF THE INDICES ILO AND IHI, WHICH MAXIMIZES THE 0011 

C FOLLOWING RATIO 0012 

C 0013 

C DNUHI) - DN(ILO) 0014 

C RATIO = 0015 

C DD(IHI) - ODULO) 0016 

C 0017 

C WHERE 0018 

C DNU.-.LD) IS ANY DISTRIBUTION FUNCTION 0019 

C D0(1.».LD) IS ANY OTHER DISTRIBUTION FUNCTION 0020 

C 0021 

C AND 0022 

C BOTH DISTRIBUTION FUNCTIONS MUST SATISFY 0023 

C 1) DU + l) EQUALS OR EXCEEDS D(t) 0024 

C 2) D(LD) EXCEEDS 0(1) 0025 

C THE LENGTH LD IS ARBITRARY 0026 

C IHI-ILO , THE WIDTH OF THE MAXIMIZING REGION, IS 0027 

C CONSTRAINED BY THE USER IN THREE WAYS 0028 

C 0029 

C DN( IHI)-DN( ILO) 0030 

C 1) T* MUST BE GRTHN* DNFRAC 0031 

C DN( LD )— DN( 1) 0032 

C AND 0033 

C DD( IHI)-DD( ILO) 0034 

C 2) — MUST BE GRTHN* ODFRAC 0035 

C DD(LD)-DDd) 0036 

C AND 0037 

C 3) IHI-ILO MUST BE GRTHN* MNREWI 0038 

C WHERE DNFRAC, DDFRAC, AND MNREWI ARE INPUTS 0039 

C 0040 

C IF ZERO DENOMINATORS OCCUR THEY ARE TREATED AS FOLLOWS- 0041 

C 0/0 IS TAKEN TO HAVE VALUE ZERO, AND A FLAG IS SET. 0042 

C 35 0043 

C K/0 WITH K GRTHN 0, IS TAKEN TO HAVE VALUf 10 0044 

C AND IS CHOSEN AS THE MAXIMUM RATIO. CA FLAG IS 0045 

C ALSO SET IN THIS CASE.) 0046 

C 0047 

C 0048 

C IF SEVERAL REGIONS HAVE THE SAME MAXIMUM RATIO THE ONE 0049 

C WITH MINIMUM ILO IS CHOSEN (IF SEVERAL HAVE THE SAME 0050 

C MINIMUM ILO, THEN THE ONE OF THIS SUBSET WITH MINIMUM 0051 

C IHI IS CHOSEN) 0052 

C 0053 

C LANGUAGE - FORTRAN II SUBROUTINE 0054 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0055 

C STORAGE - 302 REGISTERS 0056 

C SPEED - 0057 

C AUTHOR -* S-M. SIMPSON, MARCH 1963 0058 

C 0059 

C -—USAGE 0060 

C 0061 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0062 

C AND FORTRAN SYSTEM ROUTINES - EXP(2 0063 

C 0064 

C FORTRAN USAGE 0065 

C CALL MXRARE (DN , DO, LD, DNFRAC, DDFRAC, MNREW I , RAMX, ILO, IHI, IAN S3 0066 

C 0067 

C INPUTS 0068 

C 0069 

C DN(I) 1=1.. .LD IS THE NUMERATOR DISTRIBUTION FUNCTION 0070 

C 0071 

C DDU) 1*1.*. LO IS THE DENOMINATOR DISTRIBUTION FUNCTION 0072 

C (SEE ABSTRACT FOR CONDITIONS ON DN(I) AND DD(IK3 0073 

C 0074 
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C LO MUST EXCEED 1 0075 

C 0076 

C DNFRAC IS THE CONSTRAINT ON DN( IN I )-DN( ILO } (SEE ABSTRACTI • 0077 

C MUST BE GRTHN= 0, AND LSTHN- I. 0078 

C 0079 

C DOFRAC IS THE CONSTRAINT ON DD( IH I )-DD( ItO) (SEE ABSTRACTI • 0080 

C MUST BE GRTHN- 0. ANO LSTHN= 1. 0081 

C 0082 

C MNREWI IS THE CONSTRAINT ON IHI-ILO (SEE ABSTRACTI * 0083 

C MUST EXCEED ZERO AND BE LESS THAN LD 0084 

C 0085 

C OUTPUTS 0086 

C 0087 

C RAMX IS THE MAXIMUM VALUE FOUNO FOR RATIO 0088 

C 0089 

C ILO IS THE LOW INDEX OF THE MAXIMIZING REGION 0090 

C 0091 

C IHI IS THE HIGH INDEX OF THE MAXIMIZING REGION 0092 

C 0093 

C IANS = 0 NORMALLY 0094 

C = -1 FOR ILLEGAL DN (NO OTHER OUTPUT IN THIS CASE) 0095 

C = -2 FOR ILLEGAL DD (DITTO) 0096 

C » -3 FOR ILLEGAL LO (DITTO) 0097 

C = -4 FOR ILLEGAL DNFRAC (DITTO) 0098 

C = -5 FOR ILLEGAL DDFRAC (DITTO) 0099 

C * -6 FOR ILLEGAL MNREWI (DITTO) 0100 

C * 1 IF A 0/0 RATIO WAS FOUND 0101 
C - 2 IF A K/0 RATIO WAS FOUND (SUPERSEDES IAI8S*l CASE) 0102 

C EXAMPLES 0103 

C 0104 

C 1. BEHAVIOUR WITH REGION UNCONSTRAINED (IN THIS CASE IHI-ILG WILL 0105 

C ALWAYS COME OUT = 1) 0106 

C INPUTS - DN(1...10) « l.,8., 16. , 26. , 36. , 37. , 38. , 58. *59. *74* 0107 

C DD(1..*10) = -l.,0.,l.,2.,3.,4.,5.,6.,7.,8. 0108 

C LD * 10 DNFRAC = 0. DDFRAC * 0. MNREWI * 1 0109 

C OUTPUTS - IANS = 0 RAMX = 20. ILO =7 IHI » 8 0110 

C 0111 

C 2. BEHAVIOUR WITH REGION WIDTH CONSTRAINED TO BE 1,2,. ..,6 0112 

C INPUTS - SAME AS EXAMPLE 1. EXCEPT MNREWI IS SET IN USASE 0113 

C USAGE - DIMENSION RAMX( 6 ) ♦ ILCt 6) , IHI ( 6 ) , I ANS( 6 ) 0114 

C DO 10 IR=l,6 0115 

C 10 CALL MXRARECDN, DD,LD, DNFRAC, DDFRAC, IR, 0116 

C 1 RAMX(IR),ILO(IR),lHI(IR),IANS(IRlt 0117 

C OUTPUTS - IANSC1...6) = Ot 0, O t 0, 0, 0 0118 

C RAMXU...6) * 20.0, 12.0, 12.0, 9.25,8.400,8.333 0119 

C ILCU...6) = 7, 7, 7, 6, 3, 2 0120 

C IHK1...6) * 8, 10, 10, 10, 8, 8 0121 

C 0122 

C 3. BEHAVIOUR WITH CONSTRAINT ON NUMERATOR ONLY 0123 

C INPUTS - SAME AS EXAMPLE 1. EXCEPT DNFRAC( 1...3) » .35, .70, .80 0124 

C USAGE - DO 10 1=1,3 0125 

C 10 CALL MXRARE(DN,DD,LD,DNFRAC( I), DDFRAC, MNREWI, 0126 

C 1 RAMX(I),ILO(I),IHIU),IANSCm 0127 

C OUTPUTS - IANSU...3) 0, 0, 0 0128 

C RAMXU...3) = 12.0,8.286,8.250 0129 

C IL0C1...3) » 7, 3, 2 0130 

C IHH1...3) = 10, 10, 10 0131 

C 0132 

C 4. BEHAVIOUR WITH CONSTRAINT ON DENOMINATOR ONLY 0133 

C INPUTS - SAME AS EXAMPLE 1. EXCEPT DDFRAC (1*.3) * .25,^70, .80 0134 

C USAGE - 00 10 1=1,3 0135 

C 10 CALL MXRARE ( DN*DD,LD, DNFRAC, DDFRAC ( I >, MNREWI, 0136 

C 1 RAMXU),ILO( I),IHIU), IANS(U) 0137 

C OUTPUTS - SAME AS EXAMPLE 3. 0138 

C 0139 

C 5. CASES INVOLVING 2ER0/ZER0 RATIO 0140 

C INPUTS - SAME AS EXAMPLE 1. EXCEPT DDI 13=0. AND DN(l) = 8. 0141 

C AND MNREWI IS SET IN USAGE C142 

C USAGE - CALL MXRARE ( DN,DD, LD, DNFRAC, DDFRAC, WRAMX1 ♦ 0143 

C 1 IL01, IHI1, IANS1) 0144 

C CALL MXRARE(DN,DD,LD, DNFRAC, DDFRAC, 2, RAMX2, 0145 

C IL02, IH12,IANS2) 0146 

C OUTPUTS - IANS1= 1 RAMX1=20.0 IL01=7 IHI1=8 0147 

C IANS2= 0 RAMX2=12.0 IL02=7 IHI2=10 0148 

C 0149 
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C 6. CASES INVOLVING K/O RATIO 0150 

C INPUTS - SAME AS EXAMPLE 1. EXCEPT DOC I) = 0, 0151 

C AND MNREWI IS SET IN USAGE 0152 

C USAGE - SAME AS EXAMPLE 5. 0153 

C OUTPUTS - IANS1= 2 RAMX1=10**35 IL01=l IHI1=2 0154 

C IANS2* 0 RAMX2=15.0 IL02=1 IHI2=3 0155 

C 0156 

C 7. ILLEGAL CASES 0157 

C INPUTS - SAME AS EXAMPLE 1 EXCEPT AS MODIFIED IN USAGE 0158 

C CALL MXRARE 4 DN,DD» 1»0»,0.,1, RAMX, IL0»IHI*IANS1D 0159 

C CALL MXRARE < DN,DD, 2, 2* ,0* , 1,RAMX, ILO, IHI, IAN S2) 0160 

C CALL MXRARE! DN,DD,2,0«,~1*, 1,RAMX, ILO , IH I , I ANS3 ) 0161 

C CALL MXRARE(DN,DD,2,0*,0., 2, RAMX, ILO, IHI , IANS4) 0162 

C DNU) * 8. 0163 

C CALL MXRARE (DN,DD, 2, 0*,0«, 1,RAMX, ILO, IHI , I AN 55) 0164 

C BD<2) * -2. 0165 

C CALL MXRAREC DN,DD, 3, 0*,0«, 1, RAMX, ILO* IHI f I ANS61 0166 

C OUTPUTS - IANS1= -3 IANS2* -4 I ANS3* -5 IANS4* -6 0167 

C IANS5= -1 IANS6= -2 0168 

C 0169 

C PROGRAM FOLLOWS BELOW 0170 

C DUMMY DIMENSIONS 0171 

DIMENSION DN(2),DD<2> 0172 

C CHECK INPUTS IN THE ORDER LD, ( ON, DD) * DNFRAC, DDFRAC, MNREWI 0173 

C 0174 

IANS=-3 0175 

IF(LD-l) 9999,9999,10 0176 

10 DNTOTL*DN<LD)-DNU) 0177 

DDTOTL=DD<LD)-DD( 1 ) 0178 

IF ( DNTOTL ) 30,30,15 0179 

15 IF ( DDTOTL) 35,35,20 0180 

20 DO 25 1=2, LD 0181 

IF(DNII)-DNCI-m 30,23,23 0182 

23 IF(DDCI)-DDf I-m 35,25,25 0183 

25 CONTINUE 0184 

GO TO 40 0185 

30 IANS=-l 0186 

GO TO 9999 0187 

35 IANS*~2 0188 

GO TO 9999 0189 

40 IANS=~4 0190 

IF (DNFRAC) 9999,45,45 0191 

45 IFCDNFRAC-1.0) 50,50,9999 0192 

50 I ANS=~5 0193 

IF ( DDFRAC) 9999,55,55 0194 

55 IF(DDFRAC-1«,0) 60,60,9999 0195 

60 I ANS=-6 0196 

IF ( MNREWI ) 9999,9999,65 0197 

65 IF ( MNREWI-LD ) 70,9999,9999 0198 

C ALL OK 0199 

C IANS WILL BE ZERO NOW UNLESS SPECIAL CASES ENCOUNTERED 0200 

70 IANS «0 0201 

ILOT^O 0202 

0NAMNT=DNFRAC*DNT0TL 0203 

DDAMNT=DDFR AC* DDTOTL 0204 

RAMX=0. 0205 

C START NEW LOW INDEX LOOP BY INCREASING ILOT BY 1* AND SETTING 0206 

C IHIT^ILOT+MNREWl THEN CHECK FOR COMPLETION UNDER EACH OF THE 0207 

C THREE CONSTRAINTS 0208 

100 IL0T=IL0T+1 0209 

IHIT=*IL0T>MNREW1 0210 

DNILOT=DN( ILOT ) 0211 

DDI LOT-DDI I LOT) 0212 

C CHECK FOR COMPLETION WHEN HIGH INDEX RUNS OFF 0213 

110 IF(IHIT-LD) 130,130,9999 0214 

C IF INDEX OK, CHECK NUMERATOR AND DENOMINATOR CONDITIONS 0215 

130 IF (DN( IHIT)— DNIfcGT— DNAMNT) 150,140,140 0216 

140 IF<DDUHIT)*DDILOT-DDAMNT) 150,170,170 0217 

C IF CONDITIONS ON NUM AND DENCM NOT MET INCREASE IHIT BY 1 0218 

C AND GO RECHECK INDEX 0219 

150 IHIT=IHIT+1 0220 

GO TO 110 0221 

C IF ALL CONSTRAINTS SATISFIED, LOOP ON HIGH INDEX 0222 

170 DO 250 IXHI=IH!T,LD 0223 

C CHECK FOR ZEROES 0224 
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TOP*DNUXHI J-DNILOT 
BOT=DD(IXHI)-DDILOT 
IFtBOn 180,180,220 
180 IF(TOP) 190,190,200 
C SPECIAL IANS SETTING FOR 0/0 CASE 
190 IANS=1 

GO TO 250 
C SPECIAL EXIT FOR K/0 CASE 
200 IANS=2 

RAMX=10.»»3§ 
ILO=ILOT 
IHI^IXHI 
GO TO 9999 
C CHECK RATIO FOR BOT NOT ZERO 

220 IF (TOP/BOT-RAMX) 250,250,230 
C RESET TRIAL RATIO AND INDICES 
230 RAMX=TOP/BOT 
ILO=ILOT 
IHI=IXHI 
250 CONTINUE 
C WHEN FALL THRU, GO BACK FOR NEXT ILOT 
GO TO 100 

C EXIT 
9999 RETURN 
END 
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0225 
0226 
0227 
0228 
0229 
0230 
0231 
0232 
0233 
0234 
0235 
0236 
0237 
0238 
0239 
0240 
0241 
0242 
0243 
0244 
0245 
0246 
0247 
0248 
0249 



* NEXCOS * 
*#***•••*•**•******•**»* 



PROGRAM LISTINGS 



REFER TO 

SEQSAC 



*••*«•*•**«••*•*«***»•»* 

* NEXCOS * 
#**#*#******•#****••»*#* 

REFER TO 

SEQSAC 



•****»**»*••*«*•«»**•••• 

* NEXSIN * 
•***«••»•»»*****•••*»*** 

REFER TO 

SEQSAC 



*•*•*»•••*•«*««*««»***•» 

* NEXSIN * 
#*##*#••*********« *••*** 

REFER TO 

SEQSAC 
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NMZMGI (SUBROUTINE) 
FAP 



9/29/64 LAST CAtfD IN DECK IS NO. 



>NMZMGl 



COUNT 75 
LBL NMZMGI 

ENTRY NMZMGI (LX,X, XMAX, SCALE > 

* 

• ABSTRACT 

» 

» TITLE - NMZMGI 

» NORMALIZE A VECTOR TO GIVEN MAXIMUM VALUE 

• 

* NMZMGI NORMALIZES A FLOATING POINT SERIES TO A SPECIFIED 

» MAXIMUM ABSOLUTE VALUE AND RETURNS THE SCALING FACTOR USED 

« IN THE NORMALIZATION. 

• 

• LANGUAGE - FAP* SUBROUTINE (FORTRAN II COMPATIBLE) 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 

• STORAGE - 34 REGISTERS 

• SPEED - (LENGTH CF SERIES)«33 MACHINE CYCLES 

* AUTHOR - R.A. WICGINS, 17/9/62 
* 

* ~* — USAGE 

• 

» TRANSFER VECTOR CONTAINS ROUTINES 
» AND FORTRAN SYSTEM ROUTINES 

• 

» FORTRAN USAGE 

» CALL NMZMGlf LX»XtXMAX, SCALE) 



NONE 
NONE 



* INPUTS 
» 

* X(I) 
« LX 

» XMAX 

» OUTPUTS 

» XU) 
* 

* SCALE 
# 

» 

* EXAMPLES 



1*1. ..LX IS A FLOATING POINT SERIES 
MUST BC GRTHN- 1 

MAXIMUM VALUE WHICH THE X SERIES IS TO ATTAIN 

1=1.. . LX IS THE NORMALIZED (TO THE VALUE OF XMAXl SERIES 

IS THE SCALING FACTOR THAT THE ORIGINAL SERIES WAS 

DIVIDED BY TO OBTAIN THE NORMALIZED SERIES 
SCALE * MAXIMUM ABSOLUTE VALUE IN XSERIES/XMAX 



• 


1. 


INPUTS 




XU...5) 


• 




OUTPUTS 




XU...5) 


• 
• 


2. 


INPUTS 




SAME AS 


* 




OUTPUTS 




X(l.*.5) 


• 
* 


3. 


INPUTS 




XU...5) 


• 




OUTPUTS 




XU...S) 


• 
* 


4. 


INPUTS 




SAME AS 


• 




OUTPUTS 




XU...5) 


» 
» 


5. 


INPUTS 




SAME AS 


* 




OUTPUTS 




XU...5) 


» 




HTR 




0 






BCI 




I y NMZMGI 


NMZMGI SXD 




*-2»4 






SXA 




ADRtl 






CLA* 




lt4 






PDX 




tl 






CLA 




2,4 






ADD 




= IB35 






STA 




A 






STA 




A+2 






STA 




C 






STA 




C+2 



0096 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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C AL* 


2,4 


0075 




STO 


MAX 


0076 




CLA 


MAX 


0077 


A 


S8M 


**» I 


0078 




TPL 


B 


0079 




CAL 


**# 1 


0080 




STO 


MAX 


008 1 


B 


TIX 


A- 1 v 1 , 1 


0082 




CLA 


MAX 


0083 




FOP* 


3,4 


0084 




STO* 


4,4 


0085 




STQ 


MA X 


0086 




CLA* 


1,4 


0087 




PDX 


tl 


0088 


C 


CLA 


**,1 


0089 




FDP 


MAX 


0090 




STQ 


** , 1 


0091 




TIX 


Cl,l 


0092 


AOR 


AXT 


** , 1 


0093 




TRA 


5,4 


0094 


MAX 


PZE 




0095 




END 




0096 



•••«»••••*••••»•*••**•#• PROGRAM LISTINGS 

» NOINT1 « * NOINT1 * 
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» NOINT1 * SUBROUTINE) 9/29/64 LAST CARD IN ©fCK IS NO. 0374 

» FAP 0001 

•N0INT1 0002 

COUNT 370 0003 

LBL N0INT1 0004 

ENTRY N0INT1 CX,PROB) 0005 

ENTRY N0INT2 I XMEAN, XSD,NDIV,XD IVt I ANS ) 0006 

* 0007 

* —-ABSTRACT- 0008 

* 0009 

* TITLE - N0INT1 WITH SECONDARY ENTRY N0INT2 0010 

* NORMAL DISTRIBUTION ANO DIVISION INTO EQUALLY LIKELY SECTIONS 0011 

* 0012 
» N0INT1 FINDS THE INTEGRAL OF THE ZERO MEAN, UNIT VARIANCE! 0013 
« NORMAL PROBABILITY DENSITY FUNCTION FROM MINUS INFINITY 0014 

* TO X. THIS IS DONE BY TABLE LOOK UP IN A TABLE OF 201 0015 

* VALUES OF THE NORMAL DISTRIBUTION WHICH CORRESPOND 0016 

* TO VALUES OF X FROM 0*0 TO 4.0 IN INCREMENTS OF .02 0017 

* LINEAR INTERPOLATION IS USED FOR VALUES OF X LYING 0018 
» BETWEEN TABULATED VALUES. THE PROGRAM RETURNS ZERO FOR X 0019 
» VALUES LESS THAN -4.0, AND RETURNS 1*0 FOR X VALUES 0020 
« GREATER THAN 4.0. 0021 

* 0022 

* N0INT2 DIVIDES UP THE ENTIRE X AXIS INTO AN ARBITRARY 0023 
» NUMBER, NDIV, OF RANGES WHICH ARE EQUALLY LIKELY WITH 0024 
» RESPECT TO A GIVEN NORMAL DISTRIBUTION SPECIFIES BY 0025 

* ITS MEAN AND STANDARD DEVIATION. 0026 

* 0027 

* THE INTEGRAL OF THE NORMAL DISTRIBUTION GIVES THE 0028 

* PROBABILITY THAT X LIES IN A CERTAIN RANGE. N0JNT2 0029 

* REVERSES THE PROCESS BY FINDING THE X RANGES WITH 0030 
« A GIVEN PROBABILITY. 1/NDIV = PROBABILITY FOR EACH 0031 
» DIVISION. FOR K-TH DIVISION, XAXIS LIMITS CORRESPOND 0032 

* TO THE PROBABILITIES 1K-D/NDIV, K/NDIV. STORED VALUES 0033 

* OF THE ANTISYMMETRIC INTEGRAL OF THE UNIT NORMAL 0034 

* DISTRIBUTION FOR X VALUES ZERO TO 4 IN INCREMENTS OF *02 0035 

* ARE SEARCHED FOR PROBABILITY VALUES GIVEN BY K/NDIV. 0036 
« INTERPOLATION WHERE NECESSARY IS LINEAR. I.E. FIND NEAREST 0037 
« VALUE OF X TO CORRESPONDING TO P WHEN P DOES NOT APPEAR 0038 

* IN TABLE EXACTLY. IF R-TH VALUE IN TABLE IS LESS THAN P* 0039 

* AND <R+1) TH VALUE IS GREATER, THEN X VALUE * ( LP—RTH 0040 

* VALUE)/IMR*1)TH~RTH VALUE) I *.02+R».02. THIS VALUE IS 0041 

* THEN SCALED FOR THE PARTICULAR NORMAL DISTRIBUTION SUCH 0042 

* THAT THE OUTPUT X = X*XSD+MEAN. SINCE ONLY HALF OF THE 0043 
» NORMAL INTEGRAL IS STORED, THE X VALUES CORRESPONDING TO 0044 
» PI GREATER THAN .5 ARE COMPUTED FIRST AND THE VALUES 0045 
» FOR P2 LESS THAN .5 ARE SYMMETRIC AND EQUAL TO I-PK 0046 

* 0047 
» NOTE - NGINT1 AND N0INT2 ARE INDEPCNDENT EXCEPT FOR 0048 

* THEIR MUTUAL NEED OF THE DISTRIBUTION FUNCTION TABLE* 0049 

* 0050 

* LANGUAGE - FAP SUBROUTINE I FORTRAN II COMPATIBLE) 0051 

* EQUIPMENT - 709 OR 7090 < MAIN FRAME ONLY) 0052 

* STORAGE - 369 REGISTERS 0053 

* SPEED - 0054 

* AUTHOR - S.M. SIMPSON AND J.N. GALBRAITH 0055 
» 0056 

* —USAGE 0057 

» 0058 

» TRANSFER VECTOR CONTAINS ROUTINES - LINTR1 0059 

* AND FORTRAN SYSTEM ROUTINES - NONE 0060 

* 0061 

* FORTRAN USAGE OF NGINT1 0062 

* CALL NOINTl(X,PR0B) 0063 

* 0064 
» INPUTS TO N0INT1 0065 
» 0066 

* X * UPPER LIMIT OF THE INTEGRAL CFLT PT.). 0067 
» 0068 

* OUTPUTS FROM N0INT1 0069 

* 0070 

* 1 X 2 0071 

* PROB » INTEGRAL (EXPI-X /2)DX). 0072 

» SQRTI2P I ) -INFINITY 0073 

» 0074 
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* IS FLOATING POINT 0075 

* 0076 

* FORTRAN USAGE OF N01NT2 0077 

* CALL N0INT2IXMEAN, XSD, NDIV, XDIV, IANS) 0078 

* 0079 
« INPUTS TO N0INT2 0080 

* 0081 

* XMEAN * MEAN OF X SERIES 0082 

* 0083 

* XSD x STANDARD DEVIATION OF X SERIES* 0084 

* MUST BE GRTHN 0. 0085 

* 0086 

* NDIV * NUMBER OF EQUALLY LIKELY DIVISIONS INTO HHICH X SERIES 0087 

* IS TO BE PLACED, 0088 

* MUST BE GRTHN 1 0089 

* 0090 

* OUTPUTS FROM N0INT2 0091 

* 0092 

* XDIVU) I-I...NDIV-1 ARE THE X VALUES FOR EQUALLY LIKELY 0093 

* DIVISIONS. FIRST DIVISION IS FROM —INFINITY TO XDIVfll* 0094 
» THE SECOND IS FROM XDIV(l) TO XDIVI2) ETC. THE LAST 0095 

* DIVISION IS FROM XDIV(NDIV-l) TO ^INFINITY. 0096 

* 0097 
« IANS =0 NORMAL 0098 

* =1 ILtEGAL XSD 0099 

* *2 ILLEGAL NDIV 0100 

* 0101 

* EXAMPLES OF NGINT1 0102 

* 0103 

* 1. INPUTS - X*-r5. 0104 
» OUTPUTS - PROB^O. 0105 

* 0106 
« 2. INPUTS - X=-4* 0107 

* OUTPUTS - PR0B=.32 E-04 0108 

* 0109 

* 3. INPUTS - X=.013 0110 

* OUTPUTS - PR0B=.5052 0111 

* 0112 
« 4. INPUTS - X=4. 0113 

* OUTPUTS - PROB-. 999968 0114 

* 0115 

* 5. INPUTS - X=4.1 0116 

* OUTPUTS - PR0B*1. 0117 

* 0118 
» EXAMPLES OF N0INT2 0119 

* 0120 

* I. INPUTS - XMEAN-Q. XS0=l. NDIV»3 0121 

* OUTPUTS - XDIVl II*-. 430722 XDIVf 2)*. 430722 IANS*0 0122 

* 0123 

* 2. INPUTS - XMEAN=0. XSD=2. NDIV=3 0124 

* OUTPUTS - XDIVC U=-. 861444 XDIV( 2)=.861444 IANS*0 0125 

* 0126 

* 3. INPUTS - XMEAN 35 1. XSD*2. NDIV=3 0127 

* OUTPUTS - XDIVU**. 1385185 XDIV( 2)*1. 861444 lANS^O 0128 

* 0129 

* 4. INPUTS - XMEAN 35 ©. XSD=1. NDIV=2 0130 

* OUTPUTS - XDIVIU=0. IANS=0 0131 

* 0132 

* 5. INPUTS - XMEAN=3.5 XSD=1. NDIV=2 0133 

* OUTPUTS - XDIVU3 = 3.5 IANS'O 0134 

* 0135 

* 6. INPUTS - XMEAN=3.5 XSD=U. NDIV*1 0136 
» OUTPUTS - ERROR IANS=2 0137 
» 0138 

* 7. INPUTS - XMEAN=3.5 XSD=0. NDIV=2 0139 

* OUTPUTS - ERROR IANS=1 0140 

* 0141 
» 8. INPUTS - XMEAN^O. XSD=l. NDIV=4 0142 

* OUTPUTS - XDIVU... 3)=-. 674602,0., + .674602 IANS'O 0143 

* 0144 

* 9. INPUTS - XMEAN^O. XSD=1. NDIV=5 0145 
» OUTPUTS - XD I VII... 4) 8417856, -.2533 34,. 253334, i. 8417856 IANS*0 0146 
« 0147 
♦INITIALIZE. 0148 

PZE 0 0149 
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BCI 


1, NOINTl 




0150 


NOINTl 


SXA 


LV#4 




0151 




SXD 


NO! NT 1^2 ,4 




0152 




CLA 


It* 




0153 




STA 


GETX 




0154 




CLA 


2,4 




0155 




STA 


STORE 




0156 


•GET, STORE X 


AND ITS SIZE. 


COMPARE SIZE WITH 4*0. 


0157 


GETX 


CLA 


♦♦ 


•♦'ADDRESS OF X 


0158 




STO 


XX 




0159 




SSP 






0160 




STO 


SX 




0161 




CAS 


K4FL 




0162 




TRA 


BIGGER 




0163 




TRA 


INTRP 




0164 




TRA 


INTRP 




0165 


•(OR ZERO FOR NEG X). 




0166 


BIGGER 


CLA 


K1FL 




0167 




STO 


TEMP 




0168 




TRA 


CHECK 




0169 


•INTERPOLATE 


IF SIZE LESS 


THAN OR * 4.0. 


0170 


•NOTE LINTR1 


MUST BE USED 


BACKWARDS SINCE OUR 


0171 


•TABLE 


IS FORWARDS. 




0172 


INTRP 


CLA 


K4FL 




0173 




FSB 


SX 




0174 




STO 


SXMOD 




0175 




TSX 


$LINTR1,4 




0176 




TSX 


SXMOD 


SXMOD'4.0-SX 


0177 




TSX 


KO 


XLQ'0.0 


0178 




TSX 


KDELX 


KDELX'0.02 


0179 




TSX 


Y+200 


TABLE IS FORTRAN VECTOR 


0180 




TSX 


KD201 


NTABLE'201 


0181 




TSX 


TEMP 


ANSWER 


0182 


•IF X WAS MINUS WE NEEO 1.0 MINUS THE INTERPOLATED 


0183 


•VALUE. 






0184 


CHECK 


CLA 


XX 




0185 




TPL 


STORE-i 




0186 




CLA 


K1FL 




0187 




FSB 


TEMP 




0188 




TRA 


STORE 




0189 




CLA 


TEMP 




0190 


STORE 


STO 


** 


••^ADDRESS OF PROB 


0191 


LV 


AXT 


♦•♦4 


•♦*XR4 


0192 




TRA 


3,4 




0193 


•TEMPORARIES 






0194 


XX 


PZE 


*« 


• ♦-X 


0195 


sx 


PZE 


** 


♦•^MAGNITUDE OF X 


0196 


SXMOD 


PZE 


»# 


♦♦'4.0-SX 


0197 


TEMP 


PZE 


*• 


♦•'OUTPUT FROM LINTR1 


0198 


•CONSTANTS 






0199 


KO 


PZE 


0 




0200 


KD201 


PZE 


0,0,201 




0201 


K1FL 


DEC 


1.0 




0202 


K4FL 


DEC 


4.0 




0203 


KDELX 


DEC 


0.02 




0204 


* 


ENTRY 


NO! NT2 (XMEAN, XSD, NDIV, XDIV, I ANS) 


0205 


* 


SAVE 


IRS AND INITIALIZE IANS 


0206 




PZE 


0 




0207 




BCI 


1,N0INT2 




0208 


N0INT2 


SXA 


RETURN* I 




0209 




SXA 


RETURN*1,2 




0210 




SXA 


RETURNS, 4 




0211 




SXD 


N0INT2-2,4 




0212 




STZ* 


5,4 


IANS'O 


0213 


• 


CHECK 


XSD AND NDIV. 




02 1 4 




CLA» 


2,4 


GET XSD 


0215 




TZE 


ERR1 


TRANSFER IF ILLEGAL 


0216 




TMI 


ERR1 


TRANSFER IF ILLEGAL 


0217 




CLA« 


3,4 


GET NDIV 


0218 




SUB 


KIFX 


NDIV-l 


0219 




TZE 


ERR2 


TRANSFER IF ILLEGAL 


0220 




TMI 


ERR2 


TRANSFER IF ILLEGAL 


0221 


* 


PARAMETERS OK. SET 


UP MEAN LOOP AND GET XSD AND XMEAN ADDRESSES. 


0222 




STD 


END2 


SET UP MEAN LOOP 


0223 




CLA 


4,4 


ADDRESS OF XDIV 


0224 



«*•»**«••••****»•*•*•*#* PROGRAM 
» NOINT1 * 

• «»»***•*• **•'***#« 

< PAGE A) 



LISTINGS #***«**••«,#%««*«»•*•**#• 
* NOINT1 » 
****«*•**»#•••.•#••**•»#• 

I PAGE 4) 





ADO 


KMLI1 




0225 




STA 


LOOP2 




0226 




STA 


MEAN+1 




0227 




CLA 


1 .4 




0228 




STA 


MEAN 








LDQ* 


OA 
4t ,^ 








FMP 


KDELX 








STO 


SCALE 




0232 




CLA 


4, 4 


A( XDIV) 


0233 




CLA* 


3,4 


GET NDIV 


n?^4 

\fC. J", 




LRS 


18 


FLOAT IT 


0235 




ORA 


CONST 








FAD 


CONST 




U£ 3 r 




STO 


NDI VFL 


NDIVFL=FLOATF( NDIV ) 






CLA 


K1FL 




0239 




FOP 


NDI VFL 








STQ 


DELP 








CLA» 


3,4 


GET NDIV 


0242 




LGR 


19 








NDI V /2 


WITH REMAINDER IN SIGN OF MQ 


C\7 L.L. 




PAX 


M 1 




ft?4f% 




SXO 


END 1 1 




V/4t HO 




SSM 






0247 




ADD 


4.4 


t HUUnCOJ Ur AUlV# nlUlV/«. 


0248 




ADD 


KML 1 1 


AnORFSS DF Xn T Vi ND T\//7l 


0249 




STA 


STOl 




0250 




STA 


ST02 




0251 




TQP 


EVEN 


TRANSFER IF NDTV FVFN 


0252 




CLA 


DEL P 




0253 




FDP 


K2FL 




0254 




XCA 






0255 




FAD 


Y 




0256 




STO 


p 




0257 




AXT 


0. 1 




0258 




A XT 


if* 




0259 




AXT 


0*4 




0260 




TRA 


CFARf H 
jck r\ V* n 




0261 


EVEN 


AXT 






0262 




CLA 


Y 




0263 




STO 


p 




0264 




STZ» 


STOl 




0265 




AXT 






0266 




AXT 


— 1 «4 
1 # n 




0267 




AXT 


n . 1 
U f 1 




0268 


LOOP 


CLA 


p 




0269 




FAD 


DELP 




0270 




STO 


P 




0271 


SEARCH 


CAS 


Y,l 


P IS IN AC 


0272 




TXI 


SEARCH#1*-1 


TRY AGAIN 






TRA 


SKINT 


GOT IT* SKIP INTERPOLATION 


0274 




FSB 


Y-1,1 


INTERPOLATE. P-RTH VALUE 


02 75 




STO 


XTEMP1 




0276 




CLA 


Y,l 


CR+DTH 


0277 




FSB 


Y-l, 1 


RTH 


0278 




STO 


XTEMP2 




0279 




CLA 


XTEMP1 




0280 




FDP 


XTEMP2 




028 1 




FMP 


SCALE 








STO 


XTEMPl 




0283 




TRA 


SKINT+1 




0284 


SKI NT 


STZ 


XTEMPl 


ZERO INTERPOLATION 


0285 




TXI 


• ♦It 1,1 


COMPLEMENT OF INDEX OF RTH VALUE IN IR1 


0286 




SXA 


XTEMP2 #1 




0287 




PXA 


,1 


GET IR1 


0288 




PAC 


,1 


2 COMPLEMENT 


0289 




PXA 


,1 


INDEX FOR RTH VALUE =N 


0290 




ORA 


CONST 


FLOAT 


0291 




FAD 


CONST 




0292 




XCA 




FLOATFI N)=FLN IN MQ 


0293 




FMP 


SCALE 


FLN*.02*XSD=X 


0294 




FAD 


XTEMPl 




0295 


STOl 


STO 


***2 


*«=A(X0IV>-NDIV/2+l 


0296 




SSM 






0297 


ST02 


STO 


• *,4 


»»=A(XDIV)-NDIV/2+l 


0298 




LXA 


XTEMP2#1 




0299 
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TXI 


•♦1,4,-1 


0300 




TXI 


♦♦1,2,1 


0301 


ENO 


TXL 


L0GP,2#** »»»NDIV/2 ROUNDED DOWN 


0302 


• 


FINISHED SEARCH AND SCALING FOR ALL BLOCKS, ADD MEAN 


0303 




AXT 


1,2 


0304 


LC0P2 


CLA 


**,2 **=A(XDIV>+1 


0305 


MEAN 


FAD 


** XMEAN 


0306 




STO 


**,2 


0307 




TXI 


♦♦1,2,1 


0308 


EN02 


TXL 


L00P2.2,** **=NDIV-1 


0309 


RETURN 


AXT 


**t 1 


0310 




AXT 


»»#2 


0311 




AXT 


♦♦,4 


0312 




TRA 


6,4 


0313 


ERR1 


CLA 


KIFX 


0314 




STO* 5,4 


0315 




TRA 


6,4 


0316 


ERR2 


CLA 


K2FX 


0317 




STO* 5,4 


0318 




TRA 


6,4 


0319 


CONST 


OCT 


233000000000 


0320 


KIFX 


PZE 


0,0,1 


0321 


K2FX 


PZE 


0,0,2 


0322 


KMLIl 


PZE 


1 


0323 


K2FL 


DEC 


2.0 


0324 


XTEMPl 


PZE 


0 


0325 


XTEMP2 


PZE 


0 


0326 


P 


PZE 


0 


0327 


DELP 


PZE 


0 


0328 


NDIVFL 


PZE 




0329 


SCALE 


PZE 


0 


0330 


•TABLE 


< YULE AND KENDALL, THEORY OF STATISTICS, 


0331 


•1950, 


PAGE 664.) 


0332 


Y 


DEC 


.5000,. 5080,. 5160,. 5239,. 5319 


0333 




DEC 


.5398,. 5478,. 5557,. 5636,. 5714 


0334 




DEC 


* 5793, .5871 , . 5948, .6026, .6103 


0335 




DEC 


.6179,. 6255,. 6331,. 6406,. 6480 


0336 




DEC 


.6554,. 6628,. 6700,. 6772,. 6844 


0337 




DEC 


.6915,. 6985,. 7054,. 7123,. 7190 


0338 




DEC 


•7257,. 7324,. 7389,. 7454,. 7517 


0339 




DEC 


.7580,. 7642,. 7704,. 7764,. 7823 


0340 




DEC 


•7881,. 7939,. 7995,. 8051,. 8106 


0341 




DEC 


.8159,. 8212,. 8264,. 8315,. 8365 


0342 




DEC 


.8413,. 8461,. 8508,. 8554,. 8599 


0343 




DEC 


.8643, .8686,. 8729,. 8770,. 88 10 


0344 




DEC 


.8849,. 8888,. 8925,. 8962,. 8997 


0345 




DEC 


.9032,. 9066,. 9099,. 91 31,. 9162 


0346 




DEC 


.9192,. 9222,. 9251,. 9279,. 9306 


0347 




DEC 


.9332,. 9357,. 9382,. 9406,. 9429 


0348 




DEC 


.9452,. 9474,. 9495,. 95 15,. 9535 


0349 




DEC 


.9554,. 9573,. 9591, .9608,. 9625 


0350 




DEC 


*9641,. 9656,. 9671,. 9686,. 9699 


0351 




DEC 


* 9713,. 9726,. 9738,. 9750,. 9761 


0352 




DEC 


.9772,. 9783,. 9793,. 9803,. 9812 


0353 




DEC 


.9821,. 9830,. 9838, .9846,. 9854 


0354 




DEC 


.9861,. 9868,. 9875,. 9881,. 9887 


0355 




DEC 


.9893,. 9898,. 9904,. 9909,. 99 13 


0356 




DEC 


.9918, *9922,. 9927,. 9931,. 9934 


0357 




DEC 


.99379,. 9941 3,. 99446,. 99477,. 99506 


0358 




DEC 


.99534,. 99560,. 99585,. 99609,. 99632 


0359 




DEC 


.99653,. 99674,. 99693,. 9971 I,. 99728 


0360 




DEC 


.99744 #.99760,. 99774,. 99788, i 99801 


0361 




DEC 


.99813, .99825,. 99836,. 99846,. 99856 


0362 




DEC 


.99865 #.99874,. 99882,. 99889,. 99897 


0363 




DEC 


.99903,. 999 10,. 99916,. 9992 I,. 99926 


0364 




DEC 


.99931 ,.99936,. 99940,. 99944,. 99948 


0365 




DEC 


.99952, .99955,. 99958,. 99961,. 99964 


0366 




DEC 


.99966,. 99969,. 99971,. 99973,. 999 75 


0367 




DEC 


. 99977 i .99978 , . 99980, . 9998 1 , . 99983 


0368 




DEC 


.99984, .99985,. 99986,. 99987,. 99988 


0369 




DEC 


.99989, .99990,. 999908,. 999915,. 999922 


0370 




DEC 


.999928,. 999933,. 999939,. 999943,. 999948 


0371 




DEC 


k, 999952,. 999956,. 999959,. 999963,. 999966 


0372 




DEC 


.999968 


0373 




END 




0374 
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» NRMVEC (SUBROUTINE) 9/29/64 LAST CARD IS DECK IS NO* 0099 

» LABEL 0001 

CNRMVEC 0002 
SUBROUTINE NRMVEC (JOB, SCALE, X,LXiXMEAN,XMAX,XNRM) 0003 

C 0004 

C — — ABSTRACT — — 0005 

C 0006 

C TITLE - NRMVEC 0007 

C NORMALIZE AND CHANGE MEAN OF A VECTOR 0008 

C 0009 

C NRMVEC NORMALIZES A VECTOR X SO THAT EITHER ITS RMS VALUE 0010 

C OR THE ABSOLUTE MAXIMUM IS EQUAL TO A GIVEN VALUE. AFTER 0011 

C THE NORMALIZATION IS PERFORMED, A SPECIFIED NUMBER IS 0012 

C ADDED TO EACH TERM OF THE SERIES. THUS IF EITHER 0013 

C 0014 

C I LX 0015 

C XMAX = SQRTF ( SUM X< I)»X( I) > (11 0016 

C LX 1=1 0017 

C 0018 

C OR 0019 

C XMAX » ABSF ( MAX (X(I)) ) I=1,..W,LX (21 0020 

C 0021 

C THEN NRMVEC EVALUATES 0022 

C 0023 

C XNRMII) * X(I)*SCALE/XMAX + XMEAN (31 0024 

C 0025 

C WHERE SCALE AND XMEAN ARE INPUT PARAMETERS AND THE CHOICE 0026 

C OF NORMALIZATION ALSO DEPENDS ON AN INPUT PARAMETER. 0027 

C 0028 

C LANGUAGE - FORTRAN II SUBROUTINE 0029 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0030 

C STORAGE - 111 REGISTERS 0031 

C SPEED - 0032 

C AUTHOR - R.A. WIGGINS JUNE, 1963 0033 

C 0034 

C USAGE 0035 

C 0036 

C TRANSFER VECTOR CONTAINS ROUTINES - MAX A8 0037 

C AND FORTRAN SYSTEM ROUTINES - SQRT 0038 

C 0039 

C FORTRAN USAGE 0040 

C CALL NRMVECC JO 8, SCALE, X, LX, XMEAN, XMAX, XNRM) 0041 

C 0042 

C INPUTS 0043 

C 0044 

C JOB =0. IMPLIES NORMALIZATION IS TO BE MADE ON THE RMS VALUE 0045 

C OF THE SERIES (FORMULA (1) OF THE ABSTRACT). 0046 

C NOT=0. IMPLIES NORMALIZATION IS TO BE MADE ON THE 0047 

C ABSOLUTE MAXIMUM OF THE SERIES (FORMULA (2) OF THE 0048 

C ABSTRACT). 0049 

C 0050 

C SCALE IS THE VALUE THAT THE SERIES IS NORMALIZED TO. 0051 

C 0052 

C X(I) 1=1,... ,LX IS THE SERIES TO BE NORMALIZED. 0053 

C 0054 

C LX IS THE LENGTH OF X. 0055 

C MUST BE GRTHN=1 0056 

C 0057 

C XMEAN IS THE VALUE TO BE ADDED TO THE NORMALIZED SERIES. 0058 

C 0059 

C OUTPUTS 0060 

C 0061 

C XMAX IS THE MAXIMUM FOUND (BY EITHER FORMULA (1) OR FORMULA 0062 

C (2)). 0063 

C 0064 

C XNRM ( I ) 1 = 1, ...,LX IS THE SERIES NORMALIZED ACCORDING TO FORMULA 0065 

C (3) OF THE ABSTRACT. 0066 

C MAY BE EQUIVALENT OF X. 0067 

C 0068 

C EXAMPLES 0069 

C 0070 

C 1. INPUTS - J0B=1 SCALE*1. X ( 1 . . .3 )= 1. , 2. ,-4. LX=3 XMEAN=0. 0071 

C OUTPUTS - XNRMII. ..3) = .2500, .5000,-1.0000 XMAX=4. 0072 

C 0073 

C 2. INPUTS - SAME AS EXAMPLE I. EXCEPT JOB=0 0074 



*••%*«•»«•**••**•**••*»«• PROGRAM 
* NRMVEC * 
*••**«•*•*«#•*****•••*** 

C PAGE 2) 



LISTINGS ##♦#*##•»#*•»##♦****»#** 
* NRMVEC * 
#*«**•*»•***•#*•••***»«• 

i PAGE 2) 



C OUTPUTS - XNRM<1#..3) « .6546,1.3093,-2.6816 XMAX»I.'5279 0075 

C 0076 

C 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT SCALE=2. 0077 

C OUTPUTS - XNRMUJ..3) * .5000, 1.0000, -2. 0000 XMAX*4. 0078 

C 0079 

C 4. INPUTS - SAME AS EXAMPLE I. EXCEPT XMEAN=-1. 0080 

C OUTPUTS - XNRM<1,..3)= 7500,-. 5000,-2 . 0000 XMAX*4. 0081 

C 0082 

C PROGRAM FOLLOWS BELOW 0083 

C 0084 

DIMENSION X(2),XNRMC2) 0085 

IF(LX) 70,70,10 0086 

10 IFUOB) 40,20,40 0087 

20 XMAX=0. 0088 

DO 30 1*1, LX 0089 

30 XMAX=XMAX+(XU )*X( I) ) 0090 

XMAX=SQRTF ( XMAX) /FLOATF( LX ) 0091 

GO TO 50 0092 

40 CALL MAXAB (LX,X,XMAX,I) 0093 

XMAX^ABSF(XMAX) 0094 

50 SCL=SCALE/XMAX 0095 

DO 60 1=1, LX 0096 

60 XNRMU ) = X{ I)*SCL + XMEAN 0097 

70 RETURN 0098 

END 0099 
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* NTHA * * NTHA * 
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• NTHA (FUNCTION* 10/6/64 LAST CARD IN DECK IS NO. 0092 

• FAP 0001 
•NTHA 0002 

COUNT 100 0003 

LBL NTHA 0004 

ENTRY NTHA F(N, Al, A2, AN, ... ) 0005 

ENTRY XNTHA FIN, IAi, IA2, IAN, ...) 0006 

• 0007 

• 0008 

• ABSTRACT 0009 

• 0010 
» TITLE - NTHA WITH SECONDARY ENTRY XNTHA 0011 
» RETURN N-TH ARGUMENT BEYOND THE FIRST 0012 

• 0013 
» NTHA IS A FUNCTION WITH A VARIABLE NUMBER OF ARGUMENTS ♦ 0014 
» BUT A MINIMUM OF TWO* THE FIRST ARGUMENT IS AN INTEGER I 0015 
» N, EXCEEDING ZERO, AND THE VALUE OF THE FUNCTION IS THE 0016 
» N-TH ARGUMENT BEYOND THE FIRST. 0017 

• 0018 
» XNTHA IS THE FIXED POINT PSEUDONYM FOR NTHA. 0019 

• 0020 

• LANGUAGE - FAP FUNCTION I FORTRAN— 1 1 COMPATIBLE) 0021 

• EQUIPMENT - 709,7090,7094 (MAIN FRAME ONLY) 0022 

• STORAGE - 11 REGISTERS 0023 
« SPEED - 6 MACHINE CYCLES (ON 7090) FOR N = 1 0024 

• 14 MACHINE CYCLES IF N EXCEEDS 1 0025 

• AUTHOR - S.M. SIMPSON, JUNE 1964 0026 
» 002 7 
» 0028 

• USAGE 0029 

» 0030 

• TRANSFER VECTOR CONTAINS ROUTINES - I NOT ANY) 0031 

• AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0032 

• 0033 

• FORTRAN USAGE 0034 
» ARG * NTHAF(N,A1,A2,...,AN,..*) 0035 

• I ARG fc XNTHAFiN, I Al, I A2, . . . , I AN, . . * ) 0036 

• 0037 

• 0038 

• INPUTS 0039 

• 0040 

• N IS ANY INTEGER EXCEEDING ZERO 0041 

• 0042 

• A1,A2,... ARE FLOATING POINT ARGUMENTS FOR NTHA 0043 

• 0044 

• IA1,IA2*... ARE FIXED POINT ARGUMENTS FOR XNTHA 0045 
» 0046 
» 0047 

• 0048 
« OUTPUTS 0049 
» 0050 

• ARG OR I ARG WILL EQUAL THE N-TH ARGUMENT BEYOND N, 6XCEPT THAT 0051 
» IF N IS LSTHN 1 THE VALUE IS N, AND IF N EXCEEDS 0052 

• THE NUMBER OF ARGUMENTS WHICH FOLLOW, THE VALUE IS 0053 

• UNPREDICTABLE. 0054 

• 0055 

• 0056 

• EXAMPLES 0057 
» 0058 

• 1. USAGE - ARG1 = NTHAF ( 1, 3.) 0059 

• DO 10 N-1,4 0060 
« ARG (N) * NTHAF(N, 4*, 3*, 2., 1.) 0061 

• 10 1ARGIN) = XNTHAF(N, 1, 2, 3, 4) 0062 

• 0063 

• OUTPUTS - ARG1 = 3. ARGU...4) * 4.,3.,2.,1. 0064 

• IARGU...4) » 1,2,3,4 0065 

• 0066 
» 0067 
» PROGRAM FOLLOWS BELOW 0068 

• 0069 
BCI 1 , NTHA 0070 

• 0071 
» EQUIVALENT ENTRIES. NTHAF ( N, Al, A2, ...) 0072 

• AND XNTHAF ( N, IA1, IA2, 0073 

• 0074 
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NTHA BSS 0 0075 

XNTHA CAS KDl 0076 

TRA NBGRl 0077 

XCA <A1 IN MQ) 0078 

TRA 1,4 0079 

• C080 

• TREATMENT FOR N GRTHN 1 0081 

• 0082 
N8GR1 SXA SV4,4 0083 

PDX 0,4 0084 

CLA 32767,4 32767 » OCTAL 77775 + 2 0085 

SV4 AXT *»,4 0086 

TRA 1,4 0087 

» 0088 

• CONSTANT 0089 
» 0090 

KDl PZE 0,0,1 0091 

END 0092 
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* NURINC (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO* 0326 
« FAP 0001 
•NURINC 0002 

COUNT 300 0003 

LBL NURINC 0004 

ENTRY NURINC (YOFX, LY, XLO, XHI, LYNU, XLONUt XHINU* IERR1 » 0005 

* YOFXNU, IANS) 0006 
» 0007 

* 0008 

* ABSTRACT 0009 

* 0010 
» TITLE - NURINC OOU 
» CREATE ONE VECTOR FROM ANOTHER WITH NEW RANGE AND NEW INCREMENT 0012 

* 0013 
» NURINC TAKES A FUNCTION, SPECIFIED BY EVENLY SPACED 0014 

* VALUES 0015 

* 0016 
» Y(X) FOR X = XLO, XLC+DX, XL0+2DX, 0017 

* XHI=XL0+ILY-1)DX 0018 

* 0019 

* AND PRODUCES, BY LINEAR INTERPOLATION, ANOTHER SET OF 0020 
» EVENLY SPACED VALUES OF THE FUNCTION 0021 

* 0022 
« Y(X> FOR X * XLONU, XLONU+DXNU, 0023 

* XHINU=XLONU+(LYNU-l)0XNU 0024 

* 0025 
» WHERE THE PROGRAM INPUTS ARE THE FIRST SET OF VALUES OF 0026 

* Y, LY, XLO, XHI, LYNU, XLONU, AND XHINU. 0027 

* 0028 

* THE OUTPUT MAY REPLACE THE INPUT IN RESTRICTED CASES* 0029 
» 0030 

* 0031 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN—I I COMPATIBLE) 0032 
« EQUIPMENT - 709, 70f0, 7094 (MAIN FRAME ONLY) 0033 
» STORAGE - 121 REGISTERS 0034 

* SPEED - ON THE 7090 NURINC TAKES ABOUT 0035 
» 200 + 13LY + 72LYNU MACHINE CYCLES 0036 

* WHERE LY AND LYNU ARE DEFINED ABOVEJ 0037 

* AUTHOR - S.M. SIMPSON, JUNE 1964 0038 

* 0039 

* 0040 

* USAGE 0041 

» 0042 

* TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0043 

* AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0044 

* 0045 

* FORTRAN USAGE 0046 

* CALL NURINCCYOFX, LY, XLO, XHI, LYNU, XLONU, XHINU, IERR1* 0047 

* 1 YOFXNU, IANS) 0048 
» 0049 

* 0050 
» INPUTS 0051 

* 0052 
» YOFX(I) I * l.*.LY ARE THE INPUT SET OF VALUES OF Y(X) OF THE 0053 

* ABSTRACT. 0054 

* 0055 

* LY MUST BE GRTHN- 2 . 0056 
» 0057 
» XLO IS THE FIRST INPUT X VALUE, I.E., YOFX(I) * YIXL0J. 0058 

* 0059 

* XHI IS THE LAST INPUT X VALUE, I.E., YOFX(LY) * YCXH13. 0060 

* XHI MUST EXCEED XLO. 0061 

* 0062 

* LYNU IS THE DESIRED NUMBER OF OUTPUT VALUES. 0063 
» MUST BE GRTHN^ 1 . 0064 
» 0065 
« XLONU IS THE FIRST OUTPUT X VALUE, I.E., YOFXNUdX 0066 

* WILL = Y(XLONU). 0067 

* MUST SATISFY XLO LSTHN= XLONU LSTHN= XHI. 0068 
» 0069 

* XHINU IS THE LAST OUTPUT X VALUE, I.E., Y0FXNU(LYNU> 0070 
« WILL = Y(XHINU). 0071 
» HOWEVER, XHINU IS NOT REFERRED TO IF LYNU « 1 . IF 0072 

* LYNU EXCEEDS I THEN XHINU MUST SATISFY 0073 
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• XLONU LSTHN XHINU LSTHN 35 XHI. 0074 

• 0075 
» IERR1 +1 IS THE DESIRED IANS VALUE FOR ILLEGAL LY. 0076 

• SHOULD EXCEED ZERO. 0077 

• 0078 
» 0079 

• OUTPUTS 0080 

• 0081 

• YOFXNUCI) I * l.#.LYNU ARE THE LINEARLY INTERPOLATED VALUES* 0082 
» COMPUTED ONLY IF IANS = 0 . EQU IVALENCE( YOFXNU* YOFXI 0083 
» IS PERMITTED UNDER A NUMBER OF C IRCUMSTANCES* THE 0084 
» SIMPLEST OF WHICH REQUIRES SIMULTANEOUSLY 0085 

• A) XLO * XLONU » 1.0, 0086 

• B) XHI » XHINU * FLOATF(LY), 0087 

• AND C) LYNU IS LESS THAN OR EQUAL TO LY. 0088 

• IN GENERAL, THE OUTPUTS ARE STORED IN ORDER OF 0089 

• INCREASING I VALUES. ANY EQUIVALENCE WHICH OVERLAPS 0090 

• YOFXNU AND YOFX MUST ASSURE THAT THE OUTPUT STORAGE 0091 

• DOES NOT DESTROY AN INPUT VALUE NEEDED IN A SUBSEQUENT 0092 

• INTERPOLATION. NO CHECK FOR THIS CONDITION IS MADE 0093 

• BY NURINC. 0094 

• 0095 
» IANS * 0 IF ALL OK. OTHERWISE 0096 

• * IERR1+K-1 WHERE K = ARGUMENT NUMBER OF AN ILLEGAL 0097 
» INPUT ARGUMENT* 0098 

• K * 2 ( LY ) * » 4 (XHI)* » 5 (LYNU), * 6 (XLONU), 0099 
» =7 (XHINU) 0100 

• 0101 

• 0102 

• EXAMPLES 0103 

• 0104 

• 1. MISCELLANEOUS INTERPOLATIONS OF A LINEAR VECTOR 0105 

• 0106 
» INPUTS - Y0FXC1...10). = 1. , 2. , . . . , 10. LY*10. XLO*L XHI^IO. 0107 

• LYNU(1<..7) = 2,3,3,3*11,1,1 0108 
» XLGNUU...7) = l.,l.,8.5,3.1416,2.,l.,10. 0109 

• XHINUU...7) = 10.,10.,9.5,3.9,3.*43.,-17. IERR1 * 1 0110 

• USAGE - DIMENSION Y0FXNU(ll*7) 0111 

• DO 10 1*1,7 0112 

• 10 CALL NURINC(YOFX*LY,XLO,XHI,LYNUU),XLONU( I), 0113 
» 1 XHINU(I),IERR1,Y0FXNU(1,I),IANS(D) 0114 

• OUTPUTS - Y0FXNUti...2,l) = l.,10. 0115 

• YOFXNUtl...3,2) = l.,5.5,10. 0116 

• Y0FXNU(1...3,3) * 8.5,9. ,9. 5 0117 
» Y0FXNU(1...3,4) * 3.1416,3.5208,3.9000 0118 

• YOFXNUtl... 11,5) = 2. 0,2. 1,2. 2,.*. ,2. 9, 3.0 0119 

• Y0FXNU(1,6) = 1., (XHINU NOT USED) 0120 

• Y0FXNUU,7) = 10., (XHINU NOT USED) 0121 

• IANS(U..7) s 0,0, ...,0 0122 
» 0123 

• 2. SHORTEST VECTOR 0124 

• 0125 
» INPUTS - SAME AS EXAMPLE I. 0126 

• USAGE - CALL NUR INC( YOFX ( 3) , 2, 3., 4. , 3, 3. 1416* 3. 9* 1 YOFXNU, 0127 
» 1 IANS) 0128 

• OUTPUTS - Y0FXNU(i*..3) « 3.1416,3.5208,3.9000 IANS » O 0129 

• 0130 

• 3. OVERLAP OF OUTPUT ON TOP OF INPUT 0131 

• 0132 

• INPUTS - YHU..10) * Y2U...10) = I. , 2. , . . . , 10. 0133 

• USAGE - CALL NUR INC ( Y 1, 10* 1.0, 10.0, 4, 1.0, 10.0, 1, Yl, I ANSI ) 0134 

• CALL NURINC(Y2,10,l.O,10.0,10,1.0,10.0*l*iY2#IANS21 0135 

• OUTPUTS - Y1U...10) = 1.0*4.0,7.0, 10. 0*5. ,6. ,7. ,8. ,9. ,10. 0136 
» Y2U...10) = l.,2.,...,10. I ANSI = IANS2 * 0 0137 
» 0138 
» 4. ILLEGAL CASES 0139 
» 0140 

• USAGE - CALL NURINC ( YOFX , 1, 1 . , 10. * 2, 1. * 10. 1*YNU# I ANS2) 0141 
» CALL NURINC(Y0FX*2,1.,1.,2*1.,10.*1*YNU* tANS4) 0142 

• CALL NURINC (Y0FX,2*1.* 10«,0*1**10.* 1*YNU* I ANS5) 0143 

• CALL NURINC(Y0FX f 2,l.*10.,2,0*,10.*l#YNU*IANS6A) 0144 

• CALL NURINC(Y0FX,2,1.,10.,1,11.,10.*1,YNU,IANS6B) 0145 
» CALL NURINC(Y0FX,2*l.,10.,2,l*,l.,l,YNU,IANS7A) 0146 
» CALL NURINC(Y0FX*.2*1.»10.,2,1.,11.,1,YNU#IANS7BI 0147 
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* OUTPUTS 


- IANS2,4,5,6A 


,6B,7A,7B « 2,4,5,6,6,7 


,7 


0148 


• 








0149 


* 








0150 


• 








0151 


• PROGRAM FOLLOWS BELOW 






0152 


* 








0153 


♦ NO TRANSFER 


VECTOR 






0154 


* 








0155 


HTR 


0 


XR1 




0156 


HTR 


0 


XR2 




0157 


HTR 


0 


XR4 




0158 


BCI 


It NURINC 






0159 


• 








0160 


* ONLY ENTRY. 


NURINC CYOFX » 


LY,XLG,XHI,LYNU,XLONU,XHINU,IERRi,YOFXNUt 


0161 


• 


IANS) 






0162 


* 








0163 


NURINC SXD 


NURINC-4, I 






0164 


SXO 


NURINC-3,2 






0165 


SXO 


NURiNC-2,4 






0166 


• 








0167 


* SET ADDRESSES 






0168 


* 








0169 


CLA 


1,4 


A( YOFX) 




0170 


ADD 


Kl 


A< YOFXm 




0171 


STA 


CLA1 






0172 


STA 


FSB1 






0173 


STA 


FAD1 






0174 


ADD 


Kl 


A(Y0FX)+2 




0175 


STA 


CLA2 






0176 


CLA 


9,4 


A(YOFXNU) 




0177 


ADD 


Kl 


ACYOFXNU)*! 




0178 


STA 


ST02 






0179 


• 








0180 


» CHECK LY GRTHN= 2, XHI GRTHN XLO, SET DELX 




0181 


« 








0182 


CLA* 


8,4 


IERR1 




0183 


ADD 


KD1 






0184 


PDX 


0,1 


IERR1+2-1 TO XRl 




0185 


CLA* 


2,4 


LY 




0186 


CAS 


KD1 






0187 


TRA 


SUBK1 






0188 


NOP 




MUST EXCEED 1 




0189 


TRA 


LEAVE 






0190 


SUBK1 SUB 


KD1 


LY~l 




0191 


STD 


TXL1 






0192 


LRS 


18 






0193 


ORA 


OCTK 






0194 


FAD 


OCTK 






0195 


STO 


TEMP 


<LY-1) FLOATED 




0196 


TXI 


•♦1,1,2 


IERR1+4-1 




0197 


CLA* 


4,4 


XHI 




0198 


STO 


XHI 






0199 


FSB* 


3,4 


XHI-XLO 




0200 


TMI 


LEAVE 






0201 


TZE 


LEAVE 






0202 


FDP 


TEMP 






0203 


STQ 


DELX 






0204 


• 








0205 


* CHECK LYNU < 


GRTHN= 1, FORM 


(LY-1) FLOATED IF LYNU 


GRTHN 1 . 


0206 


* 








0207 


TXI 


•♦1,1,1 


IERR1+5-1 




0208 


CLA* 


5,4 


LYNU 




0209 


SUB 


KD1 


LYNU-1 




0210 


STO 


TXL2 






0211 


TMI 


LEAVE 


NG 




0212 


TNZ 


*+2 


NORMAL 




0213 


TXI 


GETXLUt 1,1 


OK BUT BYPASS XHINU 


CHECK, DELXNU SET 


0214 


SUB 


KD1 


LYNU-2 




0215 


STD 


TXL3 






0216 


ADD 


KD1 


LYNU-l 




0217 


LRS 


18 






0218 


ORA 


OCTK 






0219 


FAD 


OCTK 






0220 


STO 


TEMP 






0221 


» 








0222 
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* CHECK XHINU, SET DELXNU 0223 

* 0224 
TXI *♦!,!, 2 IERRU7-1 0225 
CLA* 7,4 XHINU 0226 
STO XHINU 0227 
CAS* 4,4 XHINU AGAINST XHI 0228 
TRA LEAVE NG 0229 
*0P OK XHINU-XLONU 0230 
FSB* 6,4 OK 0231 
TMI LEAVE 0232 
TZE LEAVE 0233 
FDP TEMP 0234 
STQ DELXNU 0235 

» 0236 

* CHECK XLONU AND SET IT 0237 

* 0238 
TXI •♦1,1,-1 IERRU6-1 0239 

GETXLU CLA* 6,4 XLONU 0240 

STO XNUNXT 0241 

CAS* 4,4 AGAINST XHI 0242 

TRA LEAVE 0243 

NOP (OK FOR LYNU = 1, IMPOSSIBLE OTHERWISE) 0244 

CAS* 3,4 AGAINST XLO 0245 

TRA START OK 0246 

TRA START OK 0247 

TRA LEAVE NG 0248 

* 0249 

* LOOP STARTS AT CAS1. INITIALIZING REQUIRED IS 0250 

* 1. XNXT * XLO IN AC, XNUNXT = XLONU IN VARIABLES TABLE 0251 

* 2. IXNXT = 1 IN XR1 0252 

* 3. IXNUNX = 1 IN XR2 0253 

* 4. XHI, XHINU, DELX, DELXNU IN VARIABLES TABLE 0254 

* 0255 

* (YOFX, YOFXNU ARE SOMETIMES CALLED Y, YNU BELOW) 0256 

* 0257 
START AXT 1,3 XRS SET 0258 

CLA* 3,4 XLO IN AC 0259 

TRA CAS1 0260 

* 0261 

* INCREMENT XNXT BUT FORCE EQUALITY WITH XHI FOR IXNXT = LY 0262 

* 0263 
XLSXNU FAD DELX 0264 

TXL1 TXL CAS1»1#*» ** = LY-i 0265 

CLA XHI 0266 

* 0267 

* XNXT IS IN AC, XR1 MAS IXNXT, XR2 HAS IXNUNX 0268 

* 0269 
CASi CAS XNUNXT XNXT AGAINST XNUNXT 0270 

TRA ST01 OK, GO INTERPOLATE 0271 

TRA EQUAL OK, GO SET 0272 

TXI XLSXNU*1,1 GO JUMP XNXT AND TRY AGAIN 0273 

EQUAL STO XNXT 0274 

CLA1 CLA **,1 ** » A(Y0FX) + 1 (GIVES YCIXNXTH 0275 

TRA ST02 0276 

* 0277 

* FORM YNU( IXNUNX) * Y ( IXNXT )-( XNXT— XNUNXT ) { Y( IXNXT)— Y( IXNXT— 1 ) 1 /DELX 0278 

* 0279 
ST01 STO XNXT 0280 

FSB XNUNXT 0281 

STO TEMP 0282 

CLA2 CLA **,1 ** * A(Y0FX)+2 GIVES Y(IXNXT-l) 0283 

FSB1 FSB **,i ** = A(Y0FX)+1 0284 

FDP DELX ~(Y( IXNXT)-Y( IXNXT-1 ) ) /DELX 0285 

FMP TEMP TIMES I XNXT-XNUNXTI 0286 

FAD1 FAD ** = A(Y0FX) + 1 PLUS YdXNXT^ 0287 

ST02 STO **,2 ** = A(Y0FXNU)+1 ( YNU( IXNUNX ) t 0288 

* 0289 

* INCREMENT XNUNXT, FORCING EQUALITY WITH XHINU FOR IXNUNX * LYNU 0290 

* 0291 
CLA XNUNXT 0292 
FAD DELXNU 0293 

TXL 2 TXL TXL3,2#*» ** « LYNU-1 COMPLETION CHECK 0294 

TRA WINDUP 0295 

TXL3 TXL ST03,2#*» ** = LYNU-2 LAST IXNUNX CHECK 0296 

CLA XHINU 0297 
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ST03 STO XNUNXT 0298 

CLA XNXT 0299 

TXI CAS1,2,1 0300 

WINDUP AXT 0,1 IANS FOR OK 0301 

* 0302 

* EXIT 0303 

* 0304 
LEAVE PXD 0,1 0305 

STO* 10,4 IANS 0306 

LXD NURINC-4,1 0307 

LXD NURINC-3,2 0308 

TRA 11,4 0309 

« 0310 

* CONSTANTS 0311 
» 0312 

Kl PZE 1 0313 

KD1 PZE 0,0,1 0314 

OCTK OCT 233000000000 0315 

» 0316 

* VARIABLES 0317 

* 0318 
XHI PZE **,«♦,#* INPUT 0319 
XHINU PZE »#,»«,#* INPUT 0320 
XNXT PZE **,*#,## = (XLO),XLO+DELX,... 0321 

XNUNXT PZE **,*«,#• = XLONU,XLONU+DELXNU,.». 0322 

DELX PZE *#,*♦,** (XHI-XL0)/(LY-1) 0323 

DELXNU PZE **,»«,## (XHINU-XL0NU)/(LYNU-1) 0324 

TEMP PZE *♦,«*,#* 0325 

END 0326 
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* NXALRM (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0177 

* LABEL OOOi 
CNXALRM 0002 

SUBROUTINE NXALRM ( JOB, MLIVt ILO, IH I , LEVEL, LTENSE, IBGIN, ISND, 0003 
1 ISUM,IANS) 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - NXALRM 0008 

C SCAN VECTOR FOR POSSIBLE BLOCK OF VALUES ALL ABOVE GIVEN LEVEL 0009 

C 0010 

C NXALRM SCANS A GIVEN RANGE OF A FIXED POINT VECTOR TO 0011 

C FIND THE NEXT BLOCK OF VALUES A) WHICH EQUAL OR EXCEED 0012 

C A GIVEN LEVEL, AND B) WHOSE BLOCK LENGTH EQUALS OR 0013 

C EXCEEDS A GIVEN LENGTH. SCANNING IS FROM LOW INDICES 0014 

C TO HIGH INDICES. OUTPUT IS FIRST AND LAST INDICES OF 0015 

C BLOCK (IF ONE IS FOUND). OPTIONAL OUTPUT IS SUM OF 0016 

C VALUES IN BLOCK. 0017 

C 0018 

C LANGUAGE - FORTRAN II SUBROUTINE 0019 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0020 

C STORAGE - 243 REGISTERS 0021 

C SPEED - FOR LONG SCANS BEFORE HITTING BLOCK, SPEED IS SAME AS THAT 0022 

C OF SUBROUTINE FASCN1 0023 

C AUTHOR - S.M. SIMPSON JR, JUNE 1962 0024 

C 0025 

C USAGE 0026 

C 0027 

C TRANSFER VECTOR CONTAINS ROUTINES - FASCN1 0028 

C AND FORTRAN SYSTEM ROUTINES - NONE 0029 

C 0030 

C FORTRAN USAGE 0031 

C CALL NXALRMI JOB, ML IV, ILO, IHI , LEVEL »LT ENS E, IBGIN, I END, 0032 

C 1 ISUM,IANS) 0033 

C 0034 

C INPUTS 0035 

C 0036 

C JOB *0 PERFORM ORDINARY COMPUTATIONS AS INDICATED BELOW. 0037 

C =1 IS A HIGH SPEED BYPASS WHICH ELIMINATES THE 0038 

C COMPUTATION OF I END AND ISUM. 0039 

C 0040 

C MLIV(I) I=ILO,...,IHI IS THE VECTOR RANGE FOR STUDY (FBXED POINT, 0041 

C WHERE THE BINARY POINT IS ARBITRARY) 0042 

C 0043 

C ILO (EXCEEDS ZERO) 0044 

C 0045 

C IHI (EQUALS OR EXCEEDS ILO) 0046 

C 0047 

C LEVEL IS THE GIVEN LEVEL (FIXED POINT, SAME BINARY POINT 0048 

C AS ML IV) 0049 

C 0050 

C LTENSE (EXCEEDS ZERO) IS THE MINIMUM BLOCK LENGTH. 0051 

C 0052 

C OUTPUTS 0053 

C 0054 

C IBGIN MLIV(IBGIN) IS FIRST VALUE IN BLOCK FOUND, IF ANY* 0055 

C IS SET *0 IF NO BLOCK FOUND. 0056 

C OG57 

C IEND MLIV(IEND) IS LAST VALUE IN BLOCK FOUND f ML IV( BENDi-ll IS 0058 

C LESS THAN LEVEL). 0059 

C IS SET =0 IF NO BLOCK FOUND. 0060 

C (IF J0B=1 AND BLOCK IS FOUND, I6N0*IBGIN+LTENSE-1 ) 0061 

C 0062 

C ISUM IS SUM OF MLIV(I) FROM I=IBGIN TO IEND (FIXED POINT, SAME 0063 

C BINARY POINT AS MLIV). NO OVERFLOW CHECK IS MADE. 0064 

C =0 IF NO BLOCK FOUND. 0065 

C (ISUM IS MEANINGLESS IF J0B=1) 0066 

C 0067 

C IANS »0 MEANS NO BLOCK FOUND. 0068 

C =1 MEANS BLOCK FOUND AND SPECIFIED 0069 

C -2 MEANS POSSIBLE BLOCK STARTED BUT RAN OFF ML IV VECTOR 0070 

C BEFORE END WAS REACHED. 0071 

C NOTE - IN THIS CASE IEND=IHI , ISUM*SUM OF ML1V0I1 FROM 0072 

C IBGIN TO IHI. 0073 
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C NOTE - BLOCK IS OEFINITE IF IHI-IBGIN+1 EQUALS OR 0074 

C EXCEEDS LTENSE. 0075 

C =-l MEANS ILLEGAL SPECIFICATION OF ILOtlHI, OR LTENSE. 0076 

C =-99 MEANS UNEXPECTED ERROR RETURN FROM FASCN1. 0077 

C 0078 

C EXAMPLES IMLI USED BELOW STANDS FOR MACHINE LANGUAGE INTEGER) 0079 

C 0080 
C 1. INPUTS - J08=0, MLIV(1...50)=MLI10,20,30,40,50,40*0#0,0,0»lt2»3,4, 0081 

C 5,6,7,8,9,10,9,8,7,6,5,4,3,2,1,0, 10,10,10,10,0,0,... 0082 

C IL0*1, IHI*50, LEVEL=ML 130, LTENSE 38 1 0083 

C OUTPUTS - IANS=1, IBGIN=3, IEND=6, ISUM=MLI160 0084 

C 0085 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT LTENSE=2 0086 

C OUTPUTS - SAME AS EXAMPLE 1. 0087 

C 0088 

C 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT LTENSE=5 0089 

C OUTPUTS - IANS=0» IBGIN, IEND, AND ISUM NOT AFFECTED* 0090 

C 0091 

C 4. INPUTS - SAME AS EXAMPLE 1. EXCEPT IL0=8, IHI=22 AND LEVEL*MLI6 0092 

C OUTPUTS - IANS=2< IBGIN=16, IEND=22 AND ISUM=MLI57 0093 

C 0094 

C 5. INPUTS - SAME AS EXAMPLE 1. EXCEPT IHl=5 AND LTENSE*5 0095 

C OUTPUTS - IANS=2, IBGIN=3, IEND=5, ANS ISUM=MLI120 0096 

C 0097 

C 6* INPUTS - SAME AS EXAMPLE 1. EXCEPT LEVEL-ML 1 50 0098 

C OUTPUTS - IANS=1, IBGIN*5, IEND=5, ISUM=*MLI50 0099 

C 0100 

C 7. INPUTS - SAME AS EXAMPLE 1. EXCEPT LEVEL =MLI6 0101 

C OUTPUTS - IANS=lt IBGIN*=l, IEND=6, ISUM=MLU90 0102 

C 0103 

C 8. INPUTS - SAME AS EXAMPLE 1. EXCEPT IHI=5t LEVEL«MLI50 0104 

C OUTPUTS - IANS=2, IBGIN=5, IEND=5, ISUM=MLI50 0105 

C 0106 

C 9. INPUTS - SAME AS EXAMPLE 1. EXCEPT IL0=10, LEVEL=MLI9, LTENSE*4 0107 

C OUTPUTS - IANS=i, IBGIN=3l, IEND=34, ISUM=MLI40 0108 

C 0109 

CIO. INPUTS - SAME AS EXAMPLE 1, EXCEPT J0B=1 0110 

C OUTPUTS - IANS=2, I8GIN=*3, IEND=3 0111 

C 0112 

DIMENSION MLIV(2) 0113 

C INITIALI ZE t CHECKING ILO, IHl, LTENSE. 0114 

IANS=-1 0115 

IF (ILO-1) 9999,10,10 0116 

10 IF UHI-ILO) 9999,20,20 0117 

20 IF (LTENSE— 1 ) 9999,50t50 0118 

C SET UP FOR FIRST SCAN TRIAL. 0119 

50 IMIN=ILO 0120 

IEND=IHI 0121 

C CLEAR I SUM AND BEGIN NEW SCAN. 0122 

100 ISUM«0 0123 

CALL FASCNifMLI¥,IMIN, IHI, LEVEL, I, IANSR) 0124 

IF < IANSR) 9900,120,200 0125 

120 CONTINUE 0126 

C NO ALARM FOUND IF FALLS THRU 120. 0127 

IANS=0 0128 

IBGIN*0 0129 

IEND=0 0130 

GO TO 9999 0131 

C LEVEL REACHED. CHECK FOR TENSE LOOP. 0132 

200 IANS=2 0133 

IBGIN* 1 1 0134 

JL0=I*i 0135 

IF U-IHI) 210#400,400 0136 

210 IF { LTENSE-! ) 300,300,220 0137 
C TENSE LOOP CHECKS FOR DEFINITE ALARM IN THE CASE LTENSE IS 2 OR GRTR. 0138 

220 JHI=JL0+LTENSE-2 0139 

IF (JHI-IHU 230,230,225 0140 

225 JHI=IHI 0141 

230 DO 240 J=JLO,JHI 0142 

ISUM=ISUM+MLIV< J-l) 0143 

IF (MLIVi J)-LEVEL) 250,240,240 0144 

240 CONTINUE 0145 

C DEFINITE ALARM IF FALLS THRU 240 0146 

C CHECK FOR J=IHI BEFORE GOING TO PULLOUT. 0147 

JL0=JHI+1 0148 
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IF (JHI-IHI) 300,400,400 0149 

C CANCEL ALARM IF JUMPS HERE FROM LOOP AND THEN RETURN TO SCAN MODE- 0150 

250 IMIN=J 0151 

GO TO 100 0152 

C DEFINITE ALARM. PULL OUT OF IT IF CAN BUT FIRST CHECK FOR HIGH SPEED 0153 

C EXIT WHICH BYPASSES PULLOUT. 0154 

300 IEND=JL0-1 0155 

IF (JOB) 310,310,400 0156 

310 IEND=IHI 0157 

DO 320 J=JLO,IHI 0158 

I SUM= I SUM+ML I V ( J-l ) 0159 

IF (MLIV( J)~LEVEL) 340,320,320 0160 

320 CONTINUE 0161 

C BOX INCOMPLETE IF FALLS THRU 320 ( ADD IN LAST SUM). 0162 

GO TO 400 0163 

C CASE WHERE CANT PULL OUT OR SPECIAL CASE WHEN LEVEL FIRST REACHED 0164 

C AT IHl. 0165 

400 ISUM*ISUM*MLIV( 1HI ) 0166 

GO TO 9999 0167 

C BOX COMPLETE IF JUMPS FROM HERE TO LOOP 0168 

340 IANS^l 0169 

IEND=J-1 0170 

GO TO 9999 0171 

C FASCN1 ERROR EXIT 0172 

9900 IANS--99 0173 

GO TO 9999 0174 

C EXIT 0175 

9999 RETURN 0176 

END 0177 
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« ONLINE (SUBROUTINE) 4/14/65 LAST CARD IN DECK IS NO* 0190 

» FAP 0001 

•ONLINE 0002 

COUNT 200 0003 

SST 0004 

L8L ONLINE 0005 

ENTRY ONLINE (ISENSE) 0006 

ENTRY (STH) (STORAGE TO TAPE HOLLERITH) 0007 

ENTRY (STHM) (STORAGE TO TAPE HOLLERITH / MONITOR) 0008 

ENTRY (STHD) ( STORAGE TO TAPE HOLLERITH / DEBUG ) 0009 

« 0010 

« 0011 

« 0012 

* — — ABSTRACT 0013 

* 0014 
« TITLE - ONLINE, WITH SECONDARY ENTRY POINTS (STH), ( STHM) , (STHD) 0015 

* OPTIONAL ONLINE MCNITOR OF BCD TAPE WRITING. 0016 
« 0017 
« SUBROUTINE CNLINE IS A MODIFICATION OF (STH) TO ALLOW 0018 
« MONITORING CF BCD TAPE OUTPUT ON THE ONLINE PRINTER. 0019 

* THIS IS ACCOMPLISHED BY SPECIFYING A SENSE SWITCH TO 0020 
« SUBROUTINE CNLINE. THEN, WHILE THIS SWITCH IS DOWN, ALL 0021 
« BCD MATERIAL THAT IS WRITTEN ON A TAPE IS ALSO PRINTED 0022 

* ON-LINE. THE SWITCH USED MAY BE ALTERED DURING THE 0023 

* PROGRAM AT WILL. 0024 
» 0025 

* THE SECONDARY ENTRIES (STH), (STHM), AND (STHO) 0026 

* FUNCTION IDENTICALLY TO THE STANDARD FORTRAN-I I SYSTEM 0027 
« ENTRIES OF THE SAME NAMES, EXCEPT FOR THIS MONITORING 0028 
« FEATURE. 0029 
« 0030 
« 0031 
« LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0032 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME, TAPE UNIT, AND ONLINE PRINTER) 0033 

* STORAGE - 134 REGISTERS 0034 
« SPEED - 0035 

* AUTHOR - R.A. WIGGINS 4/64 0036 
« 0037 
« 0038 

* USAGE 0039 

« 0040 

« TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0041 

« AND FORTRAN SYSTEM ROUTINES - ( F ID , ( IOH), (RCH) , (SPH) , (TES) , 0042 

« (WER), CWRS), (WTO 0043 

« 0044 

« FORTRAN USAGE 0045 

* CALL ONLINE ( ISENSE ) 0046 

* 0047 
« 0048 
« INPUTS 0049 

* 0050 

* ISENSE IS THE SENSE SWITCH NUMBER WHICH MUST BE OOWN TO 0051 

* ACTIVATE PRINTING. 0052 

* IF LSTHN=? 0 OR GRTHN 6 NO SWITCH IS ACTIVATED. 0053 
« 0054 
« 0055 
« OUTPUTS IF THE I SENSE SENSE SWITCH IS DOWN, ALL BCD MATERIAL THAT 0056 

* IS WRITTEN ON TAPE IS ALSO PRINTED ONLINE. 0057 

* 0058 

* 0059 

* PROGRAM FOLLOWS BELOW 0060 

* 0061 
XR4 HTR 0 0062 

BCI 1, ONLINE 0063 

eUFSIZ EQU 22 RECORD BUFFER SIZE 0064 

* 0065 
(STH) LDQ *+2 PICKUP SWITCH SETTING, AND 0066 

TRA TRAIO GO INITIALIZE (IOH). 0067 

TRA STH OUTPUT / STORAGE TO TAPE HOLLERITH. 0068 

« 0069 

* STANDARD STORAGE TO TAPE ENTRY 0070 
« 0071 

* 0072 
(STHM) LCG »*2 PICKUP SWITCH SETTING, AND 0073 

TRA ONQ GO INITIALIZE (IOH). 0074 
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TRA STHM OUTPUT / MONITOR 0075 

* 0076 



* If THIS IS ONLINE, SCAN MAIN FOR TSX $<FIL),4 AND ALTER 0077 



* TO 


TSX 


$ONL INE,4 




0078 










0079 


CNQ 


NZT 


ISENSE 


IS ISENSE SWITCH TURNED ON 


0080 




TRA 


TRAIO 


NO, WRITE OUT NORMALLY. 


0081 


PSE 


PSE 


• • 


YES, IS THE SENSE SWITCH ON 


0082 




TRA 


TRAIO 


NO, WRITE OUT NORMALLY. 


0083 




SXD 


XR4, 4 


SAVE IR 4 AND 


0084 




STO 


FMTLOC 


SAVE ACCUMULATOR* 


0085 


SRCH 


CAL 


1*4 


YES, SEARCH 


0086 




STA 


♦ ♦1 


FOR 


0087 




CAL 


** 


LOCATION ADDRESSING 


0088 




LAS 


$(FIL ) 


TTR CFIL). 


0089 




TRA 


• ♦2 




0090 




TRA 


♦ ♦2 


FOUND IT, 


0091 




TIX 


SRCH, 4,1 




0092 




CAL 


1,4 


SAVE FOR 


0093 




SLW 


TSXFIL 


FUTURE USE. 


0094 




CAL 


TRA0N2 


REPLACE WITH 


0095 




STA 


1,4 


TSX $0NLI2,4 


0096 




LXD 


XR4,4 


RESTORE IR 4 AND 


0097 




CLA 


FMTLOC 


ACCUMULATOR. 


0098 




TRA 


TRAIO 


GO INITIALIZE (IOH). 


0099 


* 








0100 


(STHD) 


LCQ 


TRAD 


PICKUP SWITCH SETTING, AND 


0101 


TRA 10 


TRA* 


$( IOH) 


* GO INITIALIZE (IOH). 


0102 


TRAD 


TRA 


STHD 


OUTPUT / DEBUG 


0103 


« 








0104 


STHOA 


LDI 


SIND 


RESTORE INDICATORS. 


0105 




AXT 


0,4 


COUNT OF DEBUG LINES PRINTED. 


0106 




TXH 


STHX, 4, 1000 


LEAVE IF NUMBER EXCEEDED. 


0107 




TXI 


♦+1,4,1 


UPDATE LINE COUNT 


0108 




SXA 


*-3,4 


AND SAVE. 


0109 




LXA 


STHX, 4 


RESTORE RETURN INDEX. 


0110 


• 








0111 


STHM 


CAL 


LINECT 


INCREASE 


0112 




ADM 


WDCNT 


LINE COUNT 


0113 




STA 


LINECT 


BY 1. 


0114 


« 








0115 


STH 


SXA 


STHX, 4 


SAVE RETURN INDEX. 


0116 


* 








0117 


TES 


TSX 


$(WER),4 


• GO CHECK PREVIOUS WRITE. 


0118 




LXA 


STHX, 4 


SET 


0119 


WDCNT 


CAL 


1,4 


WORD COUNT 


0120 




STD 


STHC 


OF WRITE COMMAND. 


0121 




AXT 


0,4 


MOVE 


0122 




SXA 


♦ ♦6,2 


RECORD 


0123 




PCX 


,2 


INTO 


0124 




CAL 


REC,4 


OUTPUT 


0125 




SLW 


OUTPUT, 4 


BUFFER 


0126 




TXI 


•♦1,4,-1 


• • 


0127 




TIX 


*-3,2,l 


• • 


0128 




AXT 


• • , 2 


• • 


0129 




CAL 


TES 


SET SWITCH FOR 


0130 




SLW« 


$( TES) 


WRITE OVERLAP. 


0131 




XEC* 


$(WRS) 


SELECT CURRENT UNIT. 


0132 




AXC 


STHC, 4 


INITIALIZE 


0133 




PXA 


,4 


FOR 


0134 




5TA* 


$(WTC) 


WRITE CHECKING. 


0135 




XEC* 


$(RCH ) 


WRITE ONE TAPE RECORD. 


0136 


STHX 


AXT 


..,4 


RESTORE RETURN INDEX. 


0137 




TRA 


2,4 


• EXIT TO (IOH). 


0138 


STHD 


STI 


SIND 


SAVE INDICATORS. 


0139 




LDI 


BLKS 


LOAD INDICATORS WITH BLANKS. 


0140 




SXA 


STHX, 4 


SAVE RETURN INDEX. 


0141 




CAL 


1,4 


PUT 2S COMPLEMENT OF NUMBER OF 


0142 




PCC 


0,4 


WORDS IN OUTPUT RECORD INTO IR 4 


0143 




TXI 


•+1,4,3 


AND REOUCE BY 3. 


0144 




ONT 


REC+1,4 


CHECK FOR NON ZERO AND NON BLANK. 


0145 




TRA 


STHDA 


FOUND (PRINT THIS LINE). 


0146 




TXI 


•♦1,4,1 


EXAMINE NEXT WORD 


0147 




TXH 


*-3,4,C 


OF OUTPUT RECORD. 


0148 




LCI 


SIND 


ENTIRE LINE HAS ONLY ZERO NUMERICS. 


0149 
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TRA STHX CONSEQUENTLY DO NOT PRINT. 0150 

« 0151 

* ONLINE ENTRY 0152 

* 0153 
CNLINE CLA* 1,4 INITIAL ONLINE ENTRANCE. GET ISENSE, 0154 

TMI PXD TEST 0155 

TZE PXD FOR 0156 

ARS 18 ILLEGAL 0157 

SUB =7B35 VALUES OF 0158 

TPL PXD ISENSE. 0159 

ADD =119835 OK, SET 0160 

STA PSE UP PSE. 0161 

CLA = 1B17 TURN ON 0162 

STOIS STO ISENSE I SENSE SWITCH 0163 

TRA 2,4 * RETURN TO MAIN. 0164 

PXD PXD 0,0 TURN OFF 0165 

TRA STOIS ISENSE 0166 

« 0167 

« IF I SENSE SWITCH ON, CONTROL COMES HERE AFTER WRITING TAPE 0168 

« 0169 

0NLI2 SXA XR4,4 SAVE LOCATION OF TSX $CFIL>,4 0170 

TSX $CFIL),4 * CALL IFID FROM HERE 0171 

LXA XR4,4 RESET IR 4 0172 

CAL TSXFIL RESET TSX ${FIL),4 0173 

STA 0,4 TO OLD DEFINITION, AND 0174 

LXO XR4,4 RESET IR4 TO INITIAL ADDRESS OF WRITING 0175 

TRA $CSPH) * LIST AND CALL PRINTING ROUTINE. 0176 

..... 0177 

ISENSE PZE 0 0178 

TSXFIL PZE 0 0179 

TRAQN2 PZE 0NLI2 0180 

FMTLOC 0181 

SIND PZE 0182 

BLKS BCI 1, 0183 

« ...... . ............... 0184 

STHC ICST OUTPUT,,.. WRITE COMMANC. 0185 

CUTPUT BSS BUFSIZ OUTPUT BUFFER. 0186 

COMMON -206+BUFSIZ 0187 

REC COMMON I 0188 

EQU 0 0189 

END 0190 
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* OUOATA (SUBROUTINE ) 3/15/65 LAST CARD IN DECK IS NO. 0268 
« LABEL 0001 
COUOATA 0002 

SUBROUTINE OUDATAUTAPE, IRECNO, NOPTS»DATA,MODCOD> 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - OUOATA 0007 

C FAST AND CONVENIENT OATA STORAGE ON TAPE 0008 

C 0009 

C OUOATA WRITES DATA AND OTHER INFORMATION ABOUT THE DATA 0010 

C ON A TAPE IN BINARY IN A FORM THAT CAN BE INTERPRETED BY 0011 

C INDATA. 0012 

C 0013 

C THE DATA AND ITS AUXILIARY INFORMATION ARE STORED IN 3 0014 

C LOGICAL BLOCKS AS FOLLOWS 0015 

C 0016 

C BLOCK 1 IS AN INDEXING BLOCK CONTAINING 5 WORDS. 0017 

C WORD 1 IS THE RECORD NUMBER IN FIXED POINT, 0018 

C FLOATING POINT, OCTAL OR ALPHANUMERIC, 0019 

C WORD 2 IS THE LENGTH OF THE AUXILIARY INFORMATION 0020 

C BLOCK IN FIXED POINT, 0021 

C WORD 3 IS THE NUMBER OF DATA VALUES IN THE DATA 0022 

C BLOCK IN FIXED POINT. 0023 

C WORD 4 IS THE NUMBER OF DATA VALUES PACKED PER 0024 

C DATA WORO IN THE DATA BLOCK IN FIXED PT. 0025 

C WORD 5 IS THE SCALE FACTOR THAT THE DATA VALUES 0026 

C WERE MULTIPLIED BY BEFORE PACKING 0027 

C - FLOATING POINT. 0028 

C 0029 

C BLOCK 2 IS THE AUXILIARY INFORMATION BLOCK OIVIDED 0030 

C INTO GROUPS OF 3. WORD 1 OF A GROUP CONTAINS THE 0031 

C ALPHANUMERIC NAME ASSOCIATED WITH A PARTICULAR PIECE 0032 

C OF INFORMATION. WORD 2 CONTAINS A FIXED POINT 0033 

C NUMBER TELLING THE LENGTH OF THE INFORMATION (N ) • 0034 

C THE FOLLOWING N WORDS CONTAIN THE AUXILIARY INFOR- 0035 

C MAT I ON IN WHATEVER MODE THAT IS ASSOCIATED WITH 0036 

C THIS INFORMATION. AN ARBITRARY NUMBER OF THESE 0037 

C INFORMATION GROUPS MAY BE WRITTEN. A BLANK WORD 0038 

C AND A SUM-CHECK WORD (AS COMPUTED BY FAPSUM) FOLLOW 0039 

C THE FINAL GROUP. 0040 

C 0041 

C BLOCK 3 CONTAINS THE DATA VALUES THAT OUOATA WILL 0042 

C SCALE, FIX, AND PACK BEFORE WRITING. THE FINAL 0043 

C DATA WORD IS FOLLOWED BY A SUM-CHECK WORO (AS 0044 

C COMPUTED BY FAPSUM) 0045 

C 0046 

C THE FINAL BLOCK IS FOLLOWED BY AN END FILE 0047 

♦ 0048 
C THE FINAL FILE OF DATA ON A DATA TAPE MUST BE FOLLOWED BY 0049 
C A DUMMY FILE WITH RECORD NO. = 0 TO IOENTIFY THE END OF 0050 
C THE DATA. 0051 
C 0052 
C THE OPERATIONS OF WRITING ARE ALL CONTROLLED BY INPUT 0053 
C PARAMETERS IN THE CALLING SEQUENCE. 0054 
C 0055 
C LANGUAGE - FORTRAN II SUBROUTINE 0056 
C EQUIPMENT - IBM 709 OR 7090 (MAIN FRAME, DATA CHANNEL AND TAPE UNIT) 0057 
C STORAGE - 495 REGISTERS 0058 
C SPEED - 0059 
C AUTHOR - J.F. CLAERBOUT AUGUST, 1962 0060 
C 0061 

C USAGE 0062 

C 0063 

C TRANSFER VECTOR CONTAINS ROUTINES - VARARG , LOC ,MVBLOK, PAKN, FAPSUM 0064 

C AND FORTRAN SYSTEM ROUTINES - ( STB ) , ( WLR ) , ( EFT ) . 0065 

C 0066 

C FORTRAN USAGE 0067 

C CALL OUDATA(ITAPE,IRECNO,NOPTS,DATA,MODCOD, 0068 

C 1 NAME1,LAUX1,AUX1, 0069 

C 2 NAME2,LAUX2,AUX2, 0070 

C . . 0071 

C . . 0072 

C N NAMEN,LAUXN, AUXN ) 0073 

C THE NUMBER OF ARGUMENTS IS VARIABLE DEPENDING UPON THE 0074 



••••***•••••••*••••••••• 

» OUDATA » 
•****•**«*•*•••••*•**••• 



PROGRAM LISTINGS 



( PAGE 2) 



* OUDATA » 
«••»*••••*•••••••••••••• 

( PAGE 2) 



INPUTS 



ITAPE 



IRECNO 

NOPTS 
DAT A( I ) 

HODCOD 



AUXILIARY INFORMATION TO BE WRITTEN. WITH THE PRESENT 
DIMENSIONING, OUDATA IS LIMITED TO 100 ARGUMENTS. 



IS THE LOGICAL TAPE NUMBER TC BE WRITTEN ON. 
MUST BE FIXED POINT. 

IS A RECORD NUMBER < SYMBOL ) WHICH IS ASSOCIATED WITH 
THE DATA. 

MAY BE FIXED POINT, FLOATING POINT, OCTAL OR ALPHANUMERIC 

IS NUMBER OF DATA POINTS. 
MUST BE GRTHN* 1 . 

1*1, NOPTS IS THE DATA TO BE WRITTEN. IF THE DATA IS TO 
BE PACKED (I.E. MODCOD GRTHN*2) IT MUST BE FLOATING 
POINT. IF IT IS NOT TO BE PACKED, THEN THE DATA MAY 
BE IN ANY MODE. ( SEE MODCOD) 

IS THE NUMBER OF DATA VALUES TO BE PACKED PER WORD. 
MUST BE GRTHN* I, LSTHN* 18 . 
IS FIXED POINT. 

NOTE THAT THE DATA IS SCALED TO THE MAXIMUM ACCURACY 
AVAILABLE FOR ANY SPECIFIC MODCOD (UNLESS MODCOD*! IN 
WHICH CASE THE DATA IS NOT TOUCHED) AND THEN FIXED 
BEFORE PACKING. THE MAXIMUM ACCURACY IS GIVEN BY 

36/MODCOD 
MAXX * 2. -1. 

IF THE INPUT SERIES CONSISTS OF FLOATING POINT INTEGERS 
ALL OF WHICH ARE LSTHN* MAXX, THEN THE ORIGINAL 
INTEGER VALUES MAY BE OBTAINED (WHEN THE TAPE IS READ 
BY SUBROUTINE INDATA ) BY ROUNDING THE OUTPUT VALUES 
TO THE NEAREST INTEGER. 



THE FOLLOWING N GROUPS OF INPUT ARGUMENTS CONTROL THE 
CONSTRUCTION OF THE AUXILIARY INFORMATION BLOCK. THESE 
ARGUMENTS OCCUR IN GROUPS OF 3 FOR EACH PIECE OF INFORMATION. 
ONLY THE N-TH CASE IS DESCRIBED. THE TOTAL LENGTH OF THE 
AUXILIARY INFORMATION BLOCK LAUXBK MUST BE LSTHN * 200 
WHERE 

N 

LAUXBK * 2 + 2N ♦ SUM LAUXN 
1 



NAM EN 



LAUXN 



AUXNU) 



OUTPUTS 
DATA(I) 



EXAMPLES 



1. USAGE 
OUTPUTS 



2. INPUTS 
USAGE 



IS A WORD THAT NAMES THE N-TH INFORMATION. 
IS GENERALLY HOLLERITH BUT MAY ALSO BE FIXED POINT, 
FLOATING POINT, OR OCTAL. 

IS THE NUMBER OF WORDS IN THE N-TH INFORMATION. 

MUST BE GRTHN* 1 . 

IS FORTRAN II INTEGER. 

1*1, LAUXN IS THE N-TH AUXILIARY INFORMATION. 
MAY BE IN ANY MODE. 
IS NEVER PACKED. 



1*1, NOPTS IS DESTROYED. THE PROGRAM CAN BE ALTERED 

TO RESTORE THE DATA (EXCEPT FOR ROUND-OFF) AS EXPLAINED 
IN A COMMENT NEAR THE END OF THE PROGRAM. 



CALL OUDATA( 9, 62, NOPTS, DATA, MODCOD) 
THE DATA IS WRITTEN WITH NO AUXILIARY INFORMATION ON 
TAPE 9. 

DT = .05 

DATE* 1... 3) = 30, 6, 1962 

CALL OUDATA( 9,63, NOPTS, DATA, MODCOD, 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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C 
C 
C 
C 

C 3. 

C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 



1 6H0ELTAT, 1, DT, 

2 4HDATE, 3, DATE I 
OUTPUTS - THE DATA IS WRITTEN 

NUMERICAL EXAMPLES 

INPUTS - IRECNOU...2) * 6H SAMPLE , 3 

DT=.05 RDAY=30 RUNI TS*6HMI CRON 

TITLE (1...8) * 6H SAMPLE INDATA-OUDATA TYPE TAPE RECORD 



USAGE - C 



OUTPUTS 



CONSTRUCT A TYPICAL OUDATA TYPE TAPE 
DATA(1)*1. 
DATA(2)*2. 
DATA(3)»3. 

CALL OUDATA ( ITAPE, IRECNO ( 1 ) ,3 , DATA, 2 ) 

DATA<1)=1. 

DATA<2)«2. 

DATA|3)*3. 

CALL OUDATA< ITAPE , IRECNOl 2) ,3, DATA, 3, 

1 6HDELTAT,1,DT, 

2 4HRDAY ,l,RDAY, 

3 6HRUNITS,l t RUNITS, 

4 5HTITLE ,8, TITLE) 

C 

C DO A ZERO RECORD NO. TO INDICATE END OF TAPE 

C 

CALL OUOATA ( ITAPE, 0,1, DATA, I ) 
THIS IS AN OCTAL LISTING OF THE BINARY TAPE FORMED. 



RECORD 1 OF FILE 1 

622144474325 
220525251252 

RECORD 2 OF FILE 1 
000000000000 

RECORD 3 OF FILE 1 
252525125252 

RECORD 1 OF FILE 2 

000003000000 
212525125252 

RECORD 2 OF FILE 2 

242543632163 
000001000000 
443123514645 
256031452421 
256051252346 
615376046704 

RECORD 3 OF FILE 2 

377725251252 

RECORD 1 OF FILE 3 

000000000000 
212525125252 

RECORD 2 OF FILE 3 
000000000000 

RECORD 3 OF FILE 3 
377725251252 



000002000000 



000000000000 



000000377777 



000003000000 000002000000 



252525525251 



000025000000 000003000000 



000001000000 
000036000000 
63316343^560 
632140466424 
512460606060 



377725251252 



174631463146 
516445316362 
000010000000 
216321606370 
606060606060 



000003000000 



512421706060 
000001000000 
606221444743 
472560632147 
000000000000 



000002000000 000001000000 000001000000 



000000000000 



377725251252 



DIMENSION DATA (5000) ,L0CSI100) , IBLOK(200) *BL0K(200) 



0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
0197 
0198 
0199 
0200 
0201 
0202 
0203 
0204 
0205 
0206 
0207 
0208 
0209 
0210 
0211 
0212 
0213 
0214 
0215 
0216 
0217 
0218 
0219 
0220 
0221 
0222 
0223 
0224 
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EQUIVALENCE ( BLOK, IBLOK ) 




0225 




CALL VARARG(LOCS) 




0226 




GO TO 20 




0227 


10 


RETURN 




0228 


20 


CONTINUE 




0229 


C 


SET UP AUXILIARY INFORMATION BLOCK AT 


BLOK 


0230 




L*l 




0231 




J»6 




0232 


30 


CONTINUE 




0233 


C 


IS AUX INFO BLOCK ALL SET UP 




0234 




IF<L0CSUn40t50,40 




0235 


40 


CONTINUE 




0236 


C 


TACK ON ANOTHER REQUEST 




0237 




CALL LOCI BLOK(L),LB) 




0238 




CALL MVBLOKll,LOCS< J), LB) 




0239 




CALL MVBL0K(1,L0CS<J*1),LB-1) 




0240 




CALL MVBL OK ( I BLOK < L+l ) , LOCS I J+2 ) » LB-2 ) 




0241 




L=L*2+IBL0K(L+1) 




0242 




J=J+3 




0243 




GO TO 30 




0244 


50 


CONTINUE 




0245 




BLOKU)*0. 




0246 


C 


APPEND SUM CHECK 




0247 




CALL FAPSUMCL, BLOK, SUMCK) 




0248 




BLQK(L+1)=SUMCK 




0249 




LAUXBK=L*1 




0250 


C 


PACK AND SCALE DATA, APPEND SUMCK 




0251 




CALL P AKN ( MOOCOD , NOPTS , DATA v SCALE ) 




0252 




NN= ( NOPTS+MODCOD- I ) /MODCOD+ 1 




0253 




NN1*NN-1 




0254 




CALL FAPSUM (NN It DATA t SUMCK) 




0255 


C 


WRITE FMT BLOCK 




0256 




WRITE TAPE ITAPE» IRECNO» LAU XBK , NOPT S» MODCOD» SCALE 


0257 


C 


WRITE AUX BLOCK 




0258 




WRITE TAPE ITAPE,CBLOKII) f I=1,LAUXBK) 




0259 


C 


WRITE DATA 




0260 




WRITE TAPE I TAPE tC DATA { I )t I=1»NN1) 9 SUMCK 


0261 




END FILE ITAPE 




0262 


60 


CONTINUE 




0263 


C 


BY REMOVING ((C)) FROM THE NEXT CARDt 


DATA WILL BE RESTORED 


0264 


C 


EXCEPT FOR ROUND-OFF ERROR* 




0265 


C 


CALL UNPAKN (MOOCOD, NOPTStDATA, SCALE) 




0266 




GO TO 10 




0267 




END 




0268 
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• PACDAT I SUBROUT INE) 9/9/64 LAST CARD IN DECK IS NO* 0258 
» FAP 0001 
•PACDAT 0002 

COUNT 20$ 0003 

LBL PACDAT 0004 

ENTRY PACDAT < I TAPE, NWORDS , IFW, IFOLD, DATA, LDATA, IANSI 0005 

« 0006 

» ^ — ABSTRACT — — 0007 

• 0008 
» TITLE - PACDAT 0009 
» READ EVERY N*TH WORD FROM BINARY TAPE 0010 
» 0011 
» PACDAT READS A SPECIFIED NUMBER OF WORDS FROM A BINARY 0012 

• RECORD OR SEQUENCE OF RECORDS, STARTING WITH A WORD WITH 0013 
» GIVEN INDEX IN THE RECORD, AND OBTAINING SUCCESSIVE WORDS 0014 

• BY SKIPPING A SPECIFIED NUMBER OF WORDS BETWEEN 0015 

• EACH READING. IT RETURNS WITH AN ERROR FLAG If AN 0016 
» END-OF*FILE OR A REDUNDANCY CHECK IS ENCOUNTERED* 0017 
» 0018 
» LANGUAGE ~ FAP SUBROUTINE {FORTRAN II COMPATIBLE) 0019 

• EQUIPMENT - 709 OR 7090 I MAIN FRAME ONLY) 0020 

• STORAGE - 152 REGISTERS 0021 

• SPEED - 0022 

• AUTHOR - R. A. WIGGINS JULY, 1963 0023 

• 0024 

• USAGE-* — 0025 

» 0026 

• TRANSFER VECTOR CONTAINS ROUTINES - NONE 0027 

• AND FORTRAN SYSTEM ROUTINES - < IOS) • ( TCO) , <RDS) , < RCH) rftETTI 0028 

• 0029 

• FORTRAN USAGE 0030 
» CALL PACDAT ( I T APE, NWORDS, I FW, IFOLD, DATA, L DAT A, I ANS ) 0031 
» 0032 
» INPUTS 0033 

• 0034 
» ITAPE INPUT TAPE NUMBER. 0035 
» MUST BE GRTHN 0 0036 

• 0037 

• NWORDS IS THE TOTAL NUMBER OF WORDS THAT IS TO BE READ. 0038 

• MUST BE GRTHN 0 0039 

• MAY BE GRTHN LENGTH OF THE RECORDS. 0040 

• 0041 
» IFW IS THE INDEX OF THE FIRST WORD TO BE READ FROM THE BLOCK. 0042 

• MUST BE GRTHN 0 0043 

• 0044 
» IFOLD IS ONE GRTHN THE NUMBER OF WORDS SKIPPED. I.E. THIS IS 0045 

• THE INCREMENT IN THE READING INDEX. 0046 

• MUST BE GRTHN 0 0047 

• 0048 

• OUTPUTS 0049 
» 0050 

• OATAU) l-l f • * t LDATA CONTAINS* EVERY IFOLD-TH VALUE READ 0051 

• BEGINNING WITH THE IFW-TH VALUE. 0052 

• 0053 

• LDATA GIVES THE NUMBER OF DATA POINTS READ. IF AN END OF FILE 0054 
» OR REDUNDANCY IS ENCOUNTERED THIS NUMBER MAY BE ONE 0055 
» LESS THEN THE ACTUAL NUMBER READ. 0056 

• 0057 
» IANS » 0 NORMALLY 0058 

• * 1 IF END OF FILE IS ENCOUNTERED. 0059 
» « 2 IF A REDUNDANCY CHECK IS ENCOUNTERED. 0060 
« *-l IF ILLEGAL ITAPE 0061 
» =-2 IF ILLEGAL NWORDS 0062 

• =-3 IF ILLEGAL IFW 0063 
» =-4 IF ILLEGAL IFOLD 0064 

• 0065 

• NOTE - IF AN END FILE IS ENCOUNTERED. THE TAPE IS POSITIONED 0066 
» IMMEDIATELY AFTER THE END FILE MARK. 0067 

• IF A REDUNDANCY IS ENCOUNTERED, THE TAPE IS POSITIONED AFTER 0068 

• THE RECORD IN WHICH THE REDUNDANCY WAS FOUND. 0069 

• AFTER A NORMAL EXIT THE TAPE IS POSITIONED AFTER THE LAST 0070 
» RECORD READ FROM. 0071 
« 0072 

• EXAMPLES 0073 
» 0074 
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» NOTE THAT FORTRAN WRITES AN EXTRA WORD AT THE BEGINNING OF EACH 

* BINARY RECORD. THIS WORD APPEARS AS A FLOATING POINT ZERO IN THESE 

* EXAMPLES. 
• 

* 1. GENERAL APPLICATION - READING WORDS FROM ONE RECORD. 

* INPUTS - ITAPE = 5 NWORDS =5 IFW = 3 I FOLD = 2 
» DATAK1...20) = 1.,2.,...20. 

* USAGE - WRITE TAPE ITAPE, ( DATA1C I ) , 1=1, 20) 
» REWIND ITAPE 

* CALL PACDAT ( ITAPE, NWORDS* IFW, IFOLD, DATA^LDATA, 

* I IANS) 

* OUTPUTS - DATAU...5) = 2. , 4. , 6. , 8. , 10* LDATA * 5 IANS = 0 
• 

» 2. READING ACROSS RECORD GAPS, TERMINATION BY AN END-FILE. 

« INPUTS - SAME AS EXAMPLE 1. EXCEPT NWORDS = 7 

* USAGE - WRITE TAPE ITAPE, ( CATA1C I ) , 1=1, 3) 

* WRITE TAPE ITAPE, i DATAK I ) , 1=4, 6) 

* WRITE TAPE ITAPE, I DAT Al i I) , 1 = 7, 8 ) 
« END FILE ITAPE 

* REWIND ITAPE 

* CALL PACDAT ( ITAPE, NWORDS, IFW, IFOLD,BATA#LOATA# 

* 1 IANS) 

* OUTPUTS - DATA! I ... 5 ) = 2. , 0. , 5. , 0. , 8. LDATA » 5 IANS * 1 
♦ 

» 3. READING ALL VALUES, TERMINATED BY A REDUNDANCY. 

* INPUTS - SAME AS EXAMPLE 1. EXCEPT IFW = 1 IFOLO = 1 NWORDS * 10 
» USAGE - WRITE TAPE ITAPE, ( DATAlf I ) , 1=1, 3) 

* WRITE TAPE ITAPE, i DATA1U ) , 1 = 3, 6) 

» WRITE OUTPUT TAPE ITAPE, 10, DATAK 11 

* 10 FORMAT ( F6. 2 ) 

* REWIND ITAPE 

» CALL PACDAT ( ITAPE, NWORDS, IFW, I FOLD, DATA* LDATA, 

» I IANS) 

« OUTPUTS ~ DATAU..-8) = 0. , 1. , 2. , 3. , 0. , 3. , 4. , 5. , 6. 

* LDATA * 9 IANS = 2 



ERROR CONDITIONS 
USAGE 



OUTPUTS 



IANS1 



CALL PACDAT ( 0, 5 , 1, 1 , DATA, LDATA, I ANSI ) 
CALL PACDAT (2,0,1,1, DATA, LDATA, IANS 2) 
CALL PACDAT (2,5,0,1, DATA, LDATA, IANS 3) 
CALL PACDAT I 2, 5, 1, 0 , DATA, LDATA, IANS4) 
IANS2 = -2 IANS 3 = -3 IANS4 



PROGRAM FOLLOWS BELOW 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 



XR4 


HTR 


0 




0120 




BCI 


1, PACDAT 




0121 


PACDAT 


SXD 


XR4,4 


SAVE 


0122 




SXA 


XRl,l 


INDEX 


0123 




SXA 


XR2,2 


REGISTERS 


0124 




CLA 


11 


SAVE 


0125 




STO 


NIF1 


CHANNEL 


0126 




CLA 


13 


TRAPPING 


0127 




STO 


NIF2 


INSTRUCTIONS 


0128 




STZ* 


7,4 


RESET IANS 10 ZERO 


0129 




CLA* 


2,4 


(=NWORDS) 


0130 




TZE 


IANM2 




0131 




TMI 


IANM2 




0132 




STO* 


6,4 




0133 




PDX 


,1 




0134 




CAL 


5,4 


=ADR ( DATA) 


0135 




STA 


IN 




0136 




CLA* 


3,4 


= IFW 


0137 




SUB 


= 1817 




0138 




TMI 


IANM3 




0139 




STD 


SKM 




0140 




TZE 


A3 




0141 




LDQ 


NOP 




0142 




CLA 


NOP 




0143 




TRA 


A4 




0144 


A3 


LDQ 


TRA2 




0145 




CLA 


LCHA1 




0146 


A4 


STA 


RCHA 




0147 




STQ 


RCHA+1 




0148 




CLA* 


4,4 


=IFOLD 


0149 
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SUB 


= 1B17 




0150 




TMI 


I ANM4 




0151 




STO 


SKN 




0152 




LDQ 


ALCH2 




0153 




TNZ 


A2 




0154 




LDQ 


ALCH1 




0155 


A2 


XCA 






0156 




ST A 


TIX 




0157 




CLA* 


1?4 


SET 


0158 




TZE 


I ANM1 


UP 


0159 




TMI 


I ANM1 


TAPE 


0160 




ADO 


= 020 


HANDLING 


0161 




TSX 


$(10S>*4 


INSTRUCTIONS. 


0162 




LXD 


XR4,4 




0163 




LDQ* 


$(TCO) 


TCO 


0164 




SLQ 


TCOA 




0165 




SLQ 


TC0A1 




0166 




LDQ* 


$(RDS) 


RTD 


0167 




STQ 


RDSA 




0168 




LDQ* 


$(RCH) 


RCH 


0169 




SLQ 


RCHA 




0170 




XCL 




LCH 


0171 




ADD 


=0000400000000 


0172 




XCL 






0173 


ALCH1 


SLQ 


LCHA1 




0174 


ALCH2 


SLQ 


LCHA2 




0175 




CAL* 


$ ( ETT ) 


LOCAT ION 


0176 




ANA 


=03000 


OF 


0177 




ARS 


9 


TRAP 


0178 




PAX 


t2 




0179 




SXA 


ruin Tti *» 

ENBIN?2 




0180 




SXD 


ENBIN, 2 




0181 




ALS 


1 




0182 




ADD 


=8635 


INDICATOR. 


0183 




STA 


TRAP 




0184 




CLA 


TRA 




0185 




STO 


11 




0186 




STO 


13 




0187 


TCOA 


TCOA 


• 


DELAY IF CHANNEL IN OPERATION. 


0188 


ROSA 


RTBA 


** 


READ SELECT. 


0189 




EN8 


ENBIN 


ENABLE BOTH CHANNELS. 


0190 


RCHA 


RCHA 


SKM 


RESET AND LOAD CHANNEL. 


0191 




NOP 






0192 


LCHA1 


LCHA 


IN 


READ ONE WORD. 


0193 




CAL 


IN 




0194 




SUB 


= 1635 




0195 




SLW 


IN 




0196 


TIX 


TIX 


LCHA2,l,l 


COUNT IT. 


0197 




TRA 


LVO 




0198 


LCHA2 


LCHA 


SKN 


SKIP IFOLD-1 WORDS 


0199 




TRA 


LCHA1 


CYCLE. 


0200 


SKM 


I OCTN 


**^ f »* 


**=IFW-1 


0201 


I N 


I OCT 


***»1 


**=ADR( DATA) 


0202 


SKN 


I OCTN 


**, f «* 


**=IF0LD-1 


0203 


LVO 


STZ* 


7,4 




0204 


LV 


CLA 


NIF1 


LEAVE. 


0205 


TCOA1 


TCOA 


• 




0206 




IOT 






0207 




NOP 






0208 




ENB 


=0 




0209 




STO 


11 




0210 




CLA 


NIF2 




0211 




STO 


13 




0212 




LXD 


XR4,4 




0213 


XR1 


AXT 


**tl 




0214 


XR2 


AXT 


**i2 




0215 




TEFA 


*+l 




0216 




TEFB 


* + l 




0217 




TRCA 


*+l 




0218 




TRCB 


* + l 




0219 




TRA 


8,4 




0220 


TRA 


TRA 


TRAP 




0221 


ENBIN 


PZE 


3, ,3 




0222 


TRAP 


LXD 


♦*t2 




0223 




TRA 


TRAl+1,2 




0224 
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NOP 




0225 




NOP 




0226 




NOP 




0227 




TRA 


ENDFL 


0228 


NOP 


NOP 


SKM 


0229 




TRA 


RFDUN 


0230 


TRA1 


TRA 


L VO NO 1 fH WAITING 


0231 


ENDFL 


CLA 


= 1617 


0232 




STO* 


7,4 


0233 


Al 


PXD 


f I 


0234 




SUB* 


Oft 


02 35 




SSP 




0236 




STO* 


A . 4 

O , *T 


0237 




TRA 


LV 


0238 


REDUN 


CLA 


-2B17 


0239 




STO* 


7t 4 


0240 




TRA 


A L 


0241 


I ANM1 


CLS 


= 1B 17 


0242 




STO* 


7.4 


0243 




TRA 


L V 


0244 


I ANM2 


CLS 


-2B 17 


0245 




STO* 


7 1 4 


0246 




TRA 


LV 


0247 


IANM3 


CLS 


= 3B17 


0248 




STO* 


7,4 


0249 




TRA 


LV 


0250 


IANM4 


CLS 


=4B17 


0251 




STO* 


7,4 


0252 




TRA 


LV 


0253 


TRA2 


TRA 


LCMAl+i 


0254 


• 








NIFl 


PZE 




0256 


NIF2 


PZE 




0257 




ENO 




0258 
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LAST CARD IN DECK IS NO* 



• PAKN 



PAKN (SUBROUTINE) 
FAP 

COUNT 150 
LBL PAKN 

ENTRY PAKN CN,LD,D, SCALE ) 

» ABSTRACT 

» 

» TITLE - PAKN 

• SCALE AND FIX DATA VECTOR * PACK N DATA POINTS PER REGISTER 
• 

» PAKN SCALES FLOATING POINT DATA TO THE LARGEST VALUE 

• COMMENSURATE WITH THE NUMBER OF DATA POINTS PER WORD* 

» ROUNDS AND FIXES THE DATA AND PACKS IT FROM RIGHT TO LEFT* 

• THE ORIGINAL DATA IS DESTROYED BY THE PROGRAM. 
• 

• LANGUAGE -FAP, SUBROUTINE i FORTRAN II COMPATIBLE) 

• EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 

• STORAGE - 78 REGISTERS 

» SPEED - ABOUT (LENGTH OF ORIGINAL VECTQR)»60 MACHINE CYCLES 

» AUTHOR - J*F. CLAERBOUT 

• 

» — — USAGE 

« 

• TRANSFER VECTOR CONTAINS ROUTINES - FXDATA 
» AND FORTRAN SYSTEM ROUTINES - NONE 
* 

» FORTRAN USAGE 

» CALL PAKN (N,LD,D, SCALE) 



• INPUTS 
* 

• N 

* 
* 

• D(I) 

• LD 

• OUTPUTS 
* 

» D(I) 
* 

» SCALE 
» 

• EXAMPLES 
• 

• 1. INPUTS 

• OUTPUTS 
* 

» 2. INPUTS 

» OUTPUTS 



IS NUMBER OF DATA POINTS PACKED PER REGISTER. 

MUST BE GRTHN=1, LSTHN=18. 

IF =1 THE DATA IS NCT SCALED OR FIXED. 

IS FORTRAN II INTEGER 

1=1.. .LD IS THE FLOATING POINT DATA SERIES TO BE PACKED* 
IS FORTRAN II INTEGER* 



I=l...(LD+N-l)/N IS THE PACKED DATA SERIES. 

IS THE SCALE FACTOR USED ON DATA 

DATA*SCALE * SCALED DATA FOR PACKING 



D(l.. 
0(1., 



.6) = 1. ,4. ,8. ,-7. ,5. ,2. LD=6 N=l 

.6) = 1. ,4. ,8. ,-7. ,5. ,2. SCALE NOT CHANGED 



SAME AS EXAMPLE 1. EXCEPT N=2 

D(t...3) = OCT 200000040000, 73777377777, 

SCALE * 16383.87 



1CG000237777 



• 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT N=5 



* 5* 



PAKN 



0146 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 



OUTPUTS 


- D(l...2) = OCT 237567720020, 000C00000040 


0059 




SCALE * 7.875 


0060 






0061 


INPUTS 


- SAME AS EXAMPLE 1. EXCEPT N=7 


0062 


OUTPUTS 


- D(l) = OCT 002117275004 SCALE « 1.875 


0063 






0064 


INPUTS 


- SAME AS EXAMPLE 1. EXCEPT N=18 


0065 


OUTPUTS 


- D(i) = OCT 000000000724 SCALE = 0.125 


0066 






0067 


HTR 


0 


0068 


BCI 


1,PAKN 


0069 


i SXD 


*-2,4 


0070 


SXA 


SV2,2 


0071 


SXA 


SV1,1 


0072 


CLA* 


1,4 


0073 


ARS 


18 


0074 
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STO 


N 










0075 




SUB 


= 1 










0076 




TZE 


5,4 










0077 




CLA 


2,4 










0078 




STA 


TSXMX+1 










0079 




CLA* 


2,4 










0080 




STD 


L 










0081 




CLA 


3,4 










0082 




STA 


TSXMX+2 










0083 




ADO 


= 1 










0084 




STA 


SS 










0085 




STA 


SL 










0086 




STA 


SD 










0087 




STA 


SF 










0088 




CLA 


=0 










0089 




LDQ 


= 36 










0090 




DVP 


N 










0091 




STQ 


NB NB « NUMBER OF BITS 


IN PACKED 


WORD 


0092 




CLA 


NB 










0093 




SUB 


= 1 










0094 




STO 


NBM 










0095 




FORM 


( (2**(NB-1) 


* WANTED MAX OF DATA 






0096 




CLA 


NBM 










0097 




STA 


*+2 










0098 




CLA 


= 1 










0099 




ALS 


•* 










0100 




STO 


NB2 










0101 




SUB 


= 1 










0102 




ALS 


18 










0103 




STO 


MAX I 










0104 




SCALE 


AND FIX 










0105 


TSXMX 


TSX 


$FXDATA,4 










0106 




TSX 


#» 


= L 








0107 




TSX 


#* 


= D 








0108 




TSX 


MAX1 










0109 




TSX 


SCALE 










0110 




REPLACE THE SIGN 










0111 




LXD 


L,l 










0112 


SF 


CLA 


**, 1 










0113 




TPL 


*+3 










0114 




SUB 


NB2 










0115 


SS 


STO 


**,1 










0116 




TIX 


SF, 1,1 










0117 




CLA 


NB 










0118 




STA 


IRS 










0119 




PACK 












0120 




AXT 


1.2 


FOR PICKUP 








0121 




AXT 


1,4 


FOR STORAGE 








0122 


NXW 


LXA 


N,l 


FOR PACK COUNT 








0123 


Si 


CAL 


**,2 


** = DATA+1 








0124 


IRS 


LGR 


*« 


** = BITS/PACKED NUMBER 






0125 




TXI 


*+l,2,l 










0126 




TIX 


SL.U1 










0127 


SD 


STQ 


**,4 


** = DATA+1 








0128 




TXI 


♦♦1,4,1 










0129 


L 


TXL 


NXW, 2,** 


**=L 








0130 




CLA 


SCALE 










0131 


SV4 


LXD 


PAKN-2*4 










0132 




STO* 


4,4 










0133 


SVl 


AXT 


**, 1 










0134 


SV2 


AXT 


**,2 










0135 




TRA 


5,4 










0136 


MAX1 


PZE 












0137 


NB 


PZE 




NUMBER OF BITS IN 


PACKED 


WORD 


0138 


NBM 


PZE 




NUMBER OF BITS IN 


PACKED 


WORD MINUS ONE 


0139 


N 


PZE 




NUMBER OF NUMBERS 


PACKED 


IN 


ONE REGISTER 


0140 


NB2 


PZE 




2**NBM 








0141 


MAX 


PZE 




MAXIMUM OF DATA 








0142 


SCALE 














0143 


ORF 


OCT 


233000000000 










0144 


AN 


OCT 


000007777777 










0145 




END 












0146 
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* PLANSP <SUBROUTINE) 9/9/64 LAST CARD IN DECK IS NO. 0382 

* LABEL 0001 
CPLANSP 0002 

SUBROUTINE PLANSP ( JOB* NRA, NCA, AA, MRS, JMAXR, MCS, JMAXC , SPT| 0003 

1 SPACE1,SPACE2, IANS) 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - PLANSP 0008 

C FAST TWO-DIMENSIONAL SPATIAL SPECTRUM 0009 

C 0010 

C PLANSP FINDS THE TWO-DIMENSIONAL SPECTRUM OF EITHER A 0011 

C CENTRO—SYMMETRIC OR A CENT RO— ANT I SYMMETRIC RECTANGULAR 0012 

C ARRAY. THAT IS, GIVEN AN ARRAY OF NUMBERS 0013 

C 0014 

C A(X,Y) X=-XL,-XL+1.,.*.,XL 0015 

C Y*-YL,-YL+1.,...,YL 0016 

C 0017 

C ( WHERE XL AND YL ARE EITHER INTEGERS OR HALF-* 0018 

C INTEGERS) THAT IS CENTRO^SYMMETR IC, 0019 

C 0020 

C A(X,Y) * At-X,-Y), 0021 

C 0022 

C THEN PLANSP EVALUATES THE FORMULA 0023 

C 0024 

C XL YL 0025 

C SP(I,J) = SUM SUMIA(X,Y)«COS( I»X*PI/MR + J*Y»PI/MCI) 0026 

C X=-XL Y=-YL 0027 

C 0028 

C OR, IF THE ARRAY IS ANTISYMMETRIC, 0029 

C 0030 

C A(X,Y) = -A<-X,-Y) , 0031 

C 0032 

C PLANSP EVALUATES THE FORMULA 0033 

C 0034 

C XL YL 0035 

C SPUttf) = SUM SUM( A< X,Y)»SIN( I*X*PI/MR * J»Y*PI/MCI> 0036 

C X=~XL Y=-YL 0037 

C 0038 

C FOR I = -JM AX R,.*,., JMAXR 0039 

C J « 0 JMAXC 0040 

C 0041 

C WHERE PI * 3.14159265, 0042 

C XL, YL, MR, MC, JMAXR, AND JMAXC ARE RELATED TO 0043 

C INPUT PARAMETERS, 0044 

C 0 LSTHN JMAXR LSTHN= MR, 0045 

C 0 LSTHN JMAXC LSTHN* MC. 0046 

C 0047 

C SPEED IS OBTAINED BY 0048 

C 0049 

C 1. ROTATING THE INPUT ARRAY TO MINIMIZE THE TOTAL 0050 

C NUMBER OP MULTIPLICATIONS. 0051 

C 2. COLLAPSING AND SPLITTING ACX,Y) i WHERE POSSIBLE ) * 0052 

C 3. USING THE HIGH-SPEED LOOPING LOGIC OF SUBROUTINE 0053 

C COSISP TO PERFORM THE TRANSFORM OF THE REDUCED 0054 

C PARTS. 0055 

C 0056 

C TEMPORARY REGISTERS ARE REQUIRED FOR THE COMPUTATIONS. 0057 

C A SPECIAL ENTRY TO PLANSP IS PROVIDED WHICH WliL GIVE 0058 

C THE SIZE NEEDED FOR A PARTICULAR SET OF INPUT PARAMETERS. 0059 

C 0060 

C LANGUAGE - FORTRAN II SUBROUTINE 0061 

C EQUIPMENT - 709 OR 7090 C MA IN FRAME ONLY) 0062 

C STORAGE - 1169 REGISTERS 0063 

C SPEED - IF MR LSTHN- XL AND 2»XL IS ODD AND IF 0064 

C MC LSTHN* YL AND 2»YL IS ODD, THE TIME IS ABOUT 0065 

C 40*( JMAXR+1)*MC»(MR+JMAXC+1) OR 0066 

C 40* ( JMAXC+l)*MR«iMC+JMAXR+l) 0067 

C MACHINE CYCLES ON THE 7090, WHICHEVER IS SMALLER. 0068 

C IF MR SRTHN XL AND 2#XL IS ODD, SUBSTITUTE 2*XL FOR MR. 0069 

C IF MC GRTHN YL AND 2*YL IS ODO, SUBSTITUTE 2*YL FOR MC. 0070 

C IF 2»XL IS EVEN SUBSTITUTE 2»MR (IF MR LSTHN* XL) 0071 

C OR 4«XL+l (IF MR GRTHN XL) FOR MR. 0072 

C IF 2»YL IS EVEN SUBSTITUTE 2*MC UF MC LSTHN* YD 0073 

C OR 4«YL+1 (IF MC GRTHN YL) FOR MC. 0074 
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C AUTHOR - R.A. WIGGINS, JULY, 1964 0075 

C 0076 

C -* USAGE 0077 

C 0078 

C TRANSFER VECTOR CONTAINS ROUTINES - CHOOSE, COS I S1,C0STBL, I XCARGtSTZ, 0079 

C LIMITS, K0LAPS,M0VREV,R0*R2^$ETK5| 0080 

C SINTBL t XAD0K,XADDKS,X002E,MATRA 0081 

C AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0082 

C 0083 

C FORTRAN USAGE 0084 

C CALL PLANSP(IJOB#NRA,NCA,AA,MRS, JMAXR,MCS, JMAXC, SPT, 0085 

C 1 SPACE1,SPACE2, IANS) 0086 

C 0087 

C INPUTS 0088 

C 0089 

C JOB =1 IMPLIES A IS CENTRO-SYMMETRIC* THE FIRST FORMULA 0090 

C DESCRIBED IN THE ABSTRACT IS EVALUATED, 0091 

C *-l IMPLIES A IS CENTRO- ANT I SYMMETRIC. THE SECOND 0092 

C FORMULA DESCRIBED IN THE ABSTRACT IS EVALUATED. 0093 

C =0 IMPLIES THAT THE USER ONLY DESIRES TO KNOW THE 0094 

C LENGTHS OF THE SPACE VECTORS. NO OUTPUTS ARE 0095 

C GIVEN OTHER THAN LANS. 0096 

C 0097 

C NRA = 2*XL AS USED IN THE ABSTRACT. 0098 

C IS THE TOTAL NUMBER OF ROWS IN A . 0099 

C MUST EXCEED 0 . 0100 

C 0101 

C NCA » 2»YL AS USED IN THE ABSTRACT. 0102 

C IS THE TOTAL NUMBER OF COLUMNS IN A . 0103 

C MUST EXCEED 0 . 0104 

C 0105 

C 0106 

C AAU) I=l,*.«,NRA«( (NCA+D/2) CONTAINS A(X,Y) X*-XL#-XL*1. ♦ 0107 

C -..,XL, Y=YZ,YZ+1.»...,YL WHERE YZ*0. IF NCA IS 0108 

C ODD, YZ=.5 IF NCA IS EVEN. AA IS STORED BY ROWS 0109 

C CLOSELY SPACED. 0110 

C 0111 

C MRS = MR IN THE ABSTRACT. 0112 

C DEFINES THE FUNDAMENTAL FREQUENCY OF THE TRANSFORM ACROSS 0113 

C THE ROWS TO HAVE A PERIOD OF 2*MRS+1 . 0114 

C MUST EXCEED 0 . 0115 

C 0116 

C JMAXR DEFINES THE HIGHEST MULTIPLE OF THE FUNDAMENTAL FREQUENCY 0117 

C DESIRED ACROSS THE ROWS. 0118 

C MUST BE GRTHN 0 LSTHN* MRS . 0119 

C 0120 

C MCS « MC IN THE ABSTRACT. 0121 

C DEFINES THE FUNDAMENTAL FREQUENCY OF THE TRANSFORM ACROSS 0122 

C THE COLUMNS TO HAVE A PERIOD OF 2*MCS+1 . 0123 

C MUST EXCEED 0 . 0124 

C 0125 

C JMAXC DEFINES THE HIGHEST MULTIPLE OF THE FUNDAMENTAL FREQUENCY 0126 

C DESIRED ACROSS THE COLUMNS. 0127 

C MUST Bf GRTHN 0 LSTHN* MCS . 0128 

C 0129 

C SPACEKI) I=1,..*,LSP1 IS TEMPORARY COMPUTATION SPACE, VfHERE 0130 

C LSP1 * 3+MAX(LSRi»NCi+MAX(NRNRi,NCNCH-LSC2), 0131 

C NRNR1*NC1+LSR1)+2»MAX(MRS,MCS) 0132 

C ( MI N ( NRA/2, MRS ) IF NRA ODD 0133 

C NR = ( 0134 

C ( MIN <NRA-1,2*MRS) IF NRA EVEN 0135 

C 0136 

C ( MIN (NCA/2,MCS) IF NCA ODD 0137 

C NC = ( 0138 

C ( MIN (NCA-1,2»MCS) IF NCA EVEN 0139 

C 0140 

C NRl=NR+l 0141 

C NRNR1=NR+NR*1 0142 

C NC1=NC+1 0143 

C NCNCl = NC*-NC + l 0144 

C LSR1«JMAXR+1 0145 

C LSR2*JMAXR+JMAXR+1 0146 

C LSC2=*JMAXC+JMAXC + l 0147 

C MAY BE EQUIVALENT TO AA 0148 

C 0149 
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C SPACE2U) I=l,..w,LSP2 IS TEMPORARY COMPUTATION SPACE, WHERE 0150 

C LSP2 * MAX(LSR1*NC1,LSC2*LSR1,NRA»UNCA + 1)/2I) 0151 

C (SEE SPACE1 FOR A DEFINITION OF THE TERMS) 0152 

C MAY 8E EQUIVALENT TO SPT. 0153 

C 0154 

C OUTPUTS 0155 

C 0156 

C SPTCI) I«1,».«,(2*JMAXR+1)»< JMAXC+1) CONTAINS SP(I,J) 0157 

C I * -JMAXR,..., JMAXR, J * 0,..., JMAXC AS DfFINEO IN 0158 

C THE ABSTRACT. IS STORED CLOSELY SPACED, BY COLUMNS. 0159 

C 0160 

C IANS(I) (1*1) * 0 NORMALLY 0161 

C * 1 IF JOB ILLEGAL 0162 

C * 2 IF NRA LSTHN= 0 0163 

C * 3 IF NCA LSTHN= 0 0164 

C * 4 IF MRS LSTHN= 0 0165 

C * 5 IF MCS LSTHN= 0 0166 

C * 6 IF JMAXR LSTHN= 0, GRTHN MRS 0167 

C =i 7 IF JMAXC LSTHN= 0, GRTHN MCS 0168 

C (1*2) * LSPl AS DEFINED UNDER SPACE1. 0169 

C (1*3) * LSP2 AS DEFINED UNDER SPACE2. 0170 

C IS THE ONLY OUTPUT IF JOB=0 0171 

C 0172 

C 0173 

C EXAMPLES 0174 

C 0175 

C 1. INPUTS - JOB * 0 NRA = 4 NCA * 4 0176 

C AA(l..w8) = 1.0 -2.0 (STORED BY COLUMNS) 0177 

C 2.0 -1.0 0178 

C 2.0 1.0 0179 

C 1.0 2.0 0180 

C MRS 2 JMAXR » 2 MCS = 2 JMAXC * 2 0181 

C OUTPUTS - IANSQ-..3) = 0,44,15 0182 

C 0183 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT JOB * 1 0184 

C OUTPUTS - IANSU...3) * 0,44,15 0185 

C SPT(1.*.15) « 0.000 -2.828 4.000 (STORED BY COLUMNS) 0186 

C 2.828 8.000 -8.485 0187 

C 12.000 8.485 0.000 0188 

C 2.828 -4.000 8.485 0189 

C 0.000 2.828 -4.000 0190 

C 0191 

C 3. INPUTS - JOB * 1 NRA » 7 NCA = 7 0192 

C AAC1...J28) = 0.0 1.0 0.0 -2.0 (STORED BY COLUMNS) 0193 

C 0.0 0.0 0.0 0.0 0194 

C 0.0 2.0 0.0 -1.0 0195 

C 0.0 0.0 0.0 0.0 0196 

C 0.0 2.0 0.0 1.0 0197 

C 0.0 0.0 0.0 0.0 0198 

C 0.0 1.0 0.0 2.0 0199 

C MRS * 4 JMAXR = 2 MCS = 4 JMAXC * 2 0200 

C OUTPUTS - IANSC1*..3) * 0,44,28 0201 

C SPTU...15) SAME AS EXAMPLE 2. 0202 

C 0203 

C 4. INPUTS - JOB * -1 NRA =5 NCA = 5 0204 

C AAH...15) * 0.1 0.2 0.1 (STORED BY COLUMNS) 0205 

C 0.4 0.3 0.2 0206 

C 0.0 0.4 0.1 0207 

C -0.4 0.5 0.0 0208 

C -0.1 0.6 -0.1 0209 

C MRS * 2 JMAXR = 2 MCS - 2 JMAXC = 2 0210 

C OUTPUTS - IANS11...3) = 0,28,15 0211 

C SPTU...15) = 0.0 0.8 0.0 (STORED BY COLUMNS) 0212 

C 0.8 -0.4 1.6 0213 

C 0.0 4.0 0.0 0214 

C -0.8 -1.2 -1.6 0215 

C 0.0 0.8 0.0 0216 

C 0217 

C 0218 

C PROGRAM FOLLOWS BELOW 0219 

C 0220 

DIMENSION AA(2),SPT(2),IANS(3),CM(2) 0221 

COMMON CM 0222 

C 0223 
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C BRING IN VARIABLES 0224 

C 0225 

CALL SETKS ( JOB* JB,NRA,NRT, NCA,NCT, MRS,MR,MCS,MC, JMAXR, JX** 0226 

1 JMAXC,JXC) 0227 

CALL LIMITS (1,IANS, JB,-1,1, NRT, 1,32768, NCT, 1,32768* 0228 

1 MR, I, 32767, MC, 1,32767, JXR,1,MR, JXC,1,MC) 0229 

IF (IANS) 10,10*1010 0230 

10 CONTINUE 0231 

CALL IXCARG (SPT,ISPT) 0232 

CALL IXCARG I SPACE1, ISP1 3 0233 

CALL IXCARG ( SPACE2, ISP2 ) 0234 

C 0235 

C MOVE XX TO SPACE1 VIA SPACE2, INSERTING ZEROS IF NEEDED 0236 

C 0237 

CALL CHOOSE (XO0ZEFINRT ) ,MR,MR+MR,MR,NR,NRT-1,NRT/2| IS,2, 1« 0238 

1 NRTA»NRT+NRT— 1 , NRT ) 0239 

CALL CHOOSE ( XO0ZEF( NCT ) ,MC, MC+MC, MC,NC, NCT-1»NCT/2»*NRTB, 0240 

1 NRTA+NRTA, NRT A ) 0241 

NCTAMNCT+U/2 0242 

LX=NCT A*NRT 0243 

IF (JB) 3000,3010,3000 0244 

3000 CONTINUE 0245 

ISP2A*LX-NRT+ISP2 0246 

LX1=NRTB«NCTA 0247 

ISP1A=LX1-NRTA+ISP1 0248 

CALL MOVREV ( LX , 1 , AA, I , CMUSP2) , I ) 0249 

CALL STZ (LXl,CMfISPl)) 0250 

DO 20 I=1,NCTA 0251 

CALL MOVREV < NRT , 1 , CMU SP2A ) , I S , CM { I SP I A ) , 1 ) 0252 

ISP2A=ISP2A~NRT 0253 

20 ISP1A«ISP1A-NRTB 0254 

2000 Q»l. 0255 

3010 CONTINUE 0256 

C DECIDE WHICH ORDER OF COMPUTATION IS FASTEST 0257 

NR1-XMI NOF ( NR, MR) 0258 

NC1=XMIN0F(NC,MC) 0259 

ICH=( JXR-JXC)«NRI*NC1+(NC1-NR1)*JXR*JXC 0260 

IF (ICH) 100,120,120 0261 

C PRESENT ORDER IS FASTEST, SHOULD WE ROTATE 0262 

100 CONTINUE 0263 

IF (MC-NC) 110,130,130 0264 

C ROTATE AND GO COLLAPSE 0265 

110 CONTINUE 0266 

IF (JB) 3020,3030,3020 0267 

3020 CONTINUE 0268 

CALL R0AR2 ( JB,SPACE1 ,NR,NC,SPACE1 ) 0269 

3030 CONTINUE 0270 

GO TO 140 0271 

C OPPOSITE ORDER IS FASTEST, ROTATE PARAMETERS 0272 

120 CONTINUE 0273 

CALL SETKS ( NR , I , NC, NR, I , NC , MR, I , MC, MR, I , MC , 0274 

1 JXR,I, JXC*JXR, I,JXC) 0275 

130 CONTINUE 0276 

140 CONTINUE 0277 

CALL XADDKS (1,NC,NC1, NC, NCI ,NCNC 1 , 1,NR,NR1, NR,NRl,NRNftl, 0278 

1 MR, MR+1 , MRMR1 , MC , MC+1 , MCMC 1 , 1,JXR,LSR1, JXR, LSRULSR2, 0279 

2 UJXCLSCU JXC,LSC1,LSC2) 0280 
C COLLAPSE ROWS IF VALID 0281 

IF (MC-NC) 160*150,150 0282 

C IT IS NOT VALID 0283 

150 CONTINUE 0284 

C SHOULD WE ROTATE 0285 

IF (ICH) 190,180,180 0286 

C IT IS VALID TO COLLAPSE 0287 

160 CONTINUE 0288 

IF (JB) 3040,3050,3040 0289 

3040 CONTINUE 0290 

CALL XADDKS (NC, ISP1 , ISM, 0,ISP1,IS1, -MC,ISM,IS2) 0291 

DO 170 1 1 = 1 , NRl 0292 

CALL KOLAPS (CMC I SM) , NC, 1. , MC,CM( ISM) , ERR 1 ) 0293 

CALL MGVREV(MCMCi,l,CM( IS2),1,CM( ISl),l) 0294 

ISM=ISM+NCNC1 0295 

IS1=IS1+MCMC1 0296 

170 IS2=IS2+NCNC1 0297 

3050 CONTINUE 0298 
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CALL XAOOKS CO,MC,NC, l,MC,NCi, NCt NClt NCNC1 ) 0299 

C REROTATE BACK AGAIN 0300 

180 CONTINUE 0301 

IF (JB) 3060,3070,3060 0302 

3060 CONTINUE 0303 

CALL R0AR2 ( JB, SPACE 1,NC,NR» SPACE 1 ) 0304 

3070 CONTINUE 0305 

190 CONTINUE 0306 

C COLLAPSE COLUMNS IF VALID TO 00 SO 0307 

IF ( MR— NR) 200,220,220 0308 

C IT IS VALID 0309 

200 CONTINUE 0310 

IF <JB) 3080,3090,3080 0311 

3080 CONTINUE 0312 

CALL XADDKS (NR|ISP1,ISM, 0,ISP1,IS1, -MR,ISM,IS2) 0313 

DO 210 I2=l,NCl 0314 

CALL KOLAPS (CMC ISM) , NR, 1. , MR,CM< ISM) , ERR2 ) 0315 

CALL MOVREV (MRMR1 , 1 ,CM< IS2) , 1, CMC IS1) , 1 ) 0316 

ISM=ISM+NRNR1 0317 

IS1=IS1+MRMR1 0318 

210 IS2=IS2+NRNRi 0319 

3090 CONTINUE 0320 

CALL XADDKS (0, WR,NR, l,NR,NRl, NR, NR1, NRNR1 ) 0321 

22,0 CONTINUE 0322 

C TRANSFORM COLUMNS, BEGINNING WITH LAST ONE. 0323 
IC = ISPl + 3+XMAX0FaSRl*NCl + XMAX0F(NRNRl,NCNCl>LSC2),NRNRl*NCl*LSRll 0324 

IS=ISP2+XMAX0F(LSR1»NC1,LSC2«LSR1) 0325 

IX=ISP1+NC*NRNR1 0326 

ICOS=IC 0327 

ISIN=IC0S*XMAX0F(MR,MC)+1 0328 

IF (JB) 3100,1000,3100 0329 

3100 CONTINUE 0330 

CALL COSTBL (MR,CM< ICOS) ) 0331 

CALL SINTBL (MR,CM( ISIN) ) 0332 

2100 Q=l. 0333 

DO 260 13=1, NCI 0334 

CALL XADDK (l-LSRl, IC, IS ) 0335 

CALL C0SIS1 I3,€MUX),NRN«1,CM< ICOS), CM! ISIN),MR*0, JXR, 0336 

1 CM(IC),CMUS),0.,CMC IX), I AND 0337 

260 IX=IX-NRNR1 0338 

C TRANSPOSE THE SINE AND COSINE VALUES 0339 

CALL MATRA «CM ( 1 C) ,LSRl , NCI , CM( IC ) ) 0340 

CALL MATRA ICM ( IS) ,LSR1 , NCI ,CM< IS > ) 0341 

2110 0*1. 0342 

C TRANSFORM THE SINES* THEN THE COSINES. 0343 

IF (MR-*MC) 270,280,270 0344 

270 CONTINUE 0345 

CALL COSTBL t MC ,CM ( ICOS ) ) 0346 

CALL SINTBL <MC*CM( ISIN) ) 0347 

280 CONTINUE 0348 
CALL XADDKS (LSC2, ISP1, IS1, NC,IS1,IS2, 0,ISPT,ISA, JXC# ISPU ICAi* 0349 

I 0, ( JB+3)/2, JB2* 0,-(JB-3)/2,JB3) 0350 

CXXXXXXXXXX 0351 

DO 325 14=1, LSR1 0352 

CALL SETKS i-l,Ml, -JB,M2, JB2,JB1, I SA+JXC, I SCI , ISA.ISC* IS, ICS) 0353 

CXXXXXXXXXXXXXXXXXXXX 0354 

DO 310 15*1,2 0355 

CALL MOVREV ( NCI , 1 ,CMU CS) , i,CM{ IS2 ) , M 1 ) 0356 

CALL MOVREV (NC#1,CM(IS2+1),-1,CM( IS1),M2) 0357 

CALL C0SIS1 <JB1,CMUS1),NCNC1,CM( ICOS),CMUSINUMC^O,JXC# 0358 

1 CMtISCl),CM( ISC1),0.,CM( IS11, IAN2) 0359 

CALL MOVREV ( JXC, 1 ,CM< I SC1 + 1 ) ,-1 , CM (I SC ) , M2 ) 0360 

CALL SETKS UB,M1, JB,M2, JB3,JB1, ICA1,ISC1, ISP1,ISC, ICICSI 0361 

310 CONTINUE 0362 

CXXXXXXXXXXXXXXXXXXXX 0363 

CXXXXX 0364 

DO 320 16=1, LS€2 0365 

CM(ISA)=CM( ISA)*CM( ISC) 0366 

320 CALL XADDK (1, ISA, ISC) 0367 

CXXXXX 0368 

2200 Q=l. 0369 

325 CALL XADDK (NC1#IC,IS) 0370 

CXXXXXXXXXX 0371 

C ANSWERS NEED TRANSPOSING IF INITIAL DATA WAS IN PROPER ORDER 0372 

IF (ICH) 330,340,340 0373 
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330 CONTINUE 0374 

CALL R0AR2 UB ,CN USPT) , JXC, JXR,CMUSPT ) ) 0375 

340 CONTINUE 0376 

1000 CONTINUE 0377 

IANS(2)=ISIN+ISIN-ICCS-ISPl 0378 

IANS(3)*XMAX0F( IS-ISP2.LX) 0379 

1010 CONTINUE 0380 

RETURN 0381 

END 0382 
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PLOTVS ( SUBROUTINE ) 9/4/64 LAST CARD IN DECK IS NO* 0260 

LABEL 0001 



CPLOTVS 0002 
SUBROUTINE PLOTVS! ITAPE, ISENSE*LOCYV, YSMBV,L YV, IXSTRV ,NYfc ARGLO, 0003 
I ARGDEL ,ZFAFXD#FMTARG, NCOLS, YBQT, YTOP,HL INV»HLSMBV»NHLI 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - PLOTVS 0008 

C PRINTER-PLOT OF ARBITRARY SET OF VECTORS 0009 

C 0010 

C PLOTVS MAKES A SIMULTANEOUS PRINTER PLOT, OFF-LINE AND/OR 0011 

C ON-LINE, OF AN ARBITRARY NUMBER OF VECTORS » FOR VIEWING 0012 

C WITH THE PAGE ROWS VERTICAL USING ONE ROW FOR EACH VECTOR 0013 

C INDEX. EACH VECTOR HAS ITS OWN LENGTH AND THE USER 0014 

C FURTHER CONTROLS WHICH ROW THE PLOTTING OF EACH VECTOR IS 0015 

C TO BEGIN IN, WHAT CHARACTER IS TO BE USED FOR BACH 0016 

C VECTOR* THE NUMERICAL LABELLING OF EACH ROW, THE NUMBER 0017 

C OF COLUMNS THE PLOT IS TO OCCUPY, THE VECTOR VALUES 0018 

C ASSOCIATED WITH THE FIRST AND LAST COLUMNS* AND THE 0019 

C POSITIONS AND CHARACTERS OF ANY HORIZONTAL LINES WHICH 0020 

C MAY BE DESIRED, 0021 

C 0022 

C THE ON-LINE PLOT OPTION MAY BE EITHER DEFINITE OR IN 0023 

C THE FORM OF MONITORING UNDER SENSE SWITCH CONTROL. 0024 

C 0025 

C LANGUAGE - FORTRAN-I I SUBROUTINE 0026 

C EQUIPMENT - 709,7090,7094 MAIN FRAME PLUS ONE TAPE DRIVE (OPTIONAL) # 0027 

C PLUS ON-LINE PRINTER (OPTIONAL), 0028 

C PLUS ONE SENSE SWITCH (OPTIONAL) 0029 

C STORAGE - 494 REGISTERS 0030 

C SPEED - THE PLOT, OVER 100 COLUMNS, OF 8 VECTORS Of LENGTH 0031 

C 300 WITH 4 HORIZONTAL LINES TAKES ABOUT 3J2 0032 

C SECONDS ON THE 7094 . 0033 

C AUTHOR - S.M. SIMPSON, MARCH 1964 0034 

C 0035 

C 0036 

C -* USAGE 0037 

C 0038 

C TRANSFER VECTOR CONTAINS ROUTINES - RND, SETKS, SETKV, SETVEC , SWI TCH 0039 

C AND FORTRAN SYSTEM ROUTINES - f F IL ) , ( SPH) , ( STH) 0040 

C 0041 

C FORTRAN USAGE 0042 

C CALL PLOTVS (I TAPE, I SENSE, LOCYV , YSMB V, LYV, I XSTRV, NY, ARGLO, ARGDEL, 0043 

C I ZFAFXD,FMTARG,NCOLS, YBOT , YTOP* HLINV, HLSMBV,NHL I 0044 

C 0045 

C 0046 

C INPUTS 0047 

C 0048 

C ITAPE IS OUTPUT TAPE NUMBER. = 0 IF NO TAPE OUTPUT. 0049 

C 0050 

C ISENSE IS A SENSE SWITCH NO. WHICH, IF ON, WILL GIVE ON LINE 0051 

C MONITORING OF OUTPUT WHILE DEPRESSED. 0052 

C IF « 0 OR NEGATIVE NO SENSE SWITCH TEST IS MADE, NO 0053 

C ON LINE OUTPUT. 0054 

C = 7 OR GREATER GIVES FULL ON LINE OUTPUT, WHETHER OR 0055 

C NOT THERE IS TAPE OUTPUT. 0056 

C 0057 

C LOCYV(I) I * l.w.NY IS A VECTOR OF MACHINE LOCATIONS OF THE Y 0058 

C SERIES TO BE PLOTTED. 0059 

C 0060 

C YSMBV(I) I * l.-.NY IS A VECTOR GIVING SYMBOLS (EACH IN FORMAT 0061 

C (AD) FOR PLOTTING CORRESPONDING Y VALUES. 0062 

C 0063 

C LYV(I) I * l.*.NY ARE THE VECTOR LENGTHS. 0064 

C 0065 

C IXSTRV(I) I * 1...NY GIVES THE ROW INDEX AT WHICH THE PLOTTING OF 0066 

C THE CORRESPONDING VECTOR IS TO START. 0067 

C 0068 

C NY IS THE NO. OF VECTORS. 0069 

C 0070 

C ARGLO IS AN ARGUMENT VALUE ASSOCIATED WITH Yd). 0071 

C 0072 

C ARGDEL IS AN INCREMENT SUCH THAT ARG ( Y( K + l ) ) *ARG ( Y ( K ) I+ARGDEL 0073 

C 0074 
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c 
c 

C EXA 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 



ZFAFXD » 0.0 IF ARGLO AND ARGDEL ARE FIXED POINT, 

NOT* 0.0 IF ARGLC AND ARGDEL ARE FLOATING POINT* 

FMTARG IS & HOLLERITH FORMAT (WITHOUT PARENTHESES J FOR PRINTING 
ARGUMENTS. THESE WILL BE PRINTED STARTING IN COLUMN 2. 

NCOLS IS WIDTH OF PLOTTING FIELD IN COLUMNS. THE FIRST COLUMN 

IMMEDIATELY FOLLOWS THE LAST ONE USED IN PRINTING ARG* 
THE LAST COLUMN USED IS NCOLS- 1 BEYOND THE FIRST COLUMN 

YBOT IS VALUE OF Y ASSOCIATED WITH FIRST COLUMN OF PLOTTING 

FIELD. 

YTOP IS VALUE OF Y ASSOCIATED WITH LAST COLUMN OF PLOTTING 

FIELD. 

VALUES OF Y OUTSIDE THESE LIMITS ARE IGNORED* 
YTOP MAY BE LESS THAN OR GREATER THAN YBOT. 

HLINV(I) I * I. ..NHL IS A VECTOR OF Y VALUES AT WHICH HORIZONTAL 
LINES ARE TO BE DRAWN (HORIZONTAL WHEN PAGE IS VIEWED 
WITH COLUMNS HORIZONTAL). 

HLSMBVU) I * l.W.NHL IS VECTOR OF SYMBOLS (EACH IN FORMAT (All! OF 
THE CORRESPONDING HORIZONTAL LINES. 



NHL 



MPLES 
INPUTS 



USAGE 



OUTPUTS 



IS NO. OF DESIRED HORIZONTAL LINES. NHL MAY Bf ZERO* IN 
WHICH CASE BOTH HLINV AND HLSMBV ARE IGNORED. 

IN CASE OF CRISS-CROSS OF TWO OR MORE Y VECTORS THE 
ASTERISK f*) SYMBOL IS USED AT THE INTERSECTION. IF A Y 
VECTOR INTERSECTS A HORIZONTAL LINE THE Y VECTOR SYMBOL 
IS USED. 



YK1...13) = 130., 140. ,...,250. 

Y2IU..8) * 50. ,80., ...,260. 

Y3I1...4) * 280.,240.,...,160. 

L0CYVU...3) = XLCCFIYl),XL0CF(Y2),XL0CF|Y3) 

YSMBVU...3) = 1HA,1HB,1HC LYVU...3) » 13,8,4 

IXSTRVll..*3) = 3,5,18 NY » 3 I ARGLO = 0 

IARGDL » 1 ZFAFXD = 0.0 FMTARG = 2HI2 

NCOLS * 31 YBOT = 0.0 YTOP * 300.0 

HLINVU...4) = 0., 100. ,200., 300. 

HLSMBV ( 1. • .4) = lHZtlH., 1H., IH. NHL * 4 

CALL PLOTVS { 2, 7, LOCYV* YSMBV* LYV, IXSTRV,NY, I ARGLO, 

1 IARGDL, ZFAFXD, FMTARG, NCOLS, YBOT, YTOP, 

2 HLINV, HLSMBV, NHL) 

21 ROWS ARE PRINTED ON-LINE AND OFF-LINE FROM LOGICAL 2, 
OCCUPYING COLUMNS 1 THRU 34 ( COLUMN 1 IS BLANK I , AS 
SHOWN BEGINNING 2 LINES BELOW. 



OZ 
1Z 
21 
3Z 
4Z 
5Z 
6Z 
7Z 
8Z 
9Z 
10Z 
HZ 
12Z 
13Z 
14Z 
15Z 
16Z 
17Z 
18Z 
19Z 



B A 
B A 
B A 



A B 
A B 
A 

A 

A 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
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C 20Z C . 0149 

C 0150 

C 0151 

C PROGRAM FOLLOWS BELOW. 0152 

C 0153 

DIMENSION L0CYV(2),YSMBV(2),LYV(2),IXSTRV(2),HLINV(2) f H»lSMBVm 0154 

DIMENSION FMT(4>,STAGE(131), COM ( 2) 0155 

EQUIVALENCE ( AR@, I ARG) 0156 

COMMON COM 0157 

C 0158 

C SET PLOTTING FORMAT*ARG, IARGO,FLOATF(NCOLS) , IXR0W»1 , SPACES, »ROWS*0 0159 

C 0160 

CALL SETVEClFMT*4H(lX f , FMTARG,6H, 131A1, 1H) ) 0161 

CALL SETKS(ARGLQ,ARG, ARGDEL, I ARGD, FLOATF( NCOLS) ,FNC, 0162 

1 1,IXR0W, 6H f SPACESt 0, NROWS) 0163 

SCALE = (FNC-1.0)/(YT0P-YB0T) 0164 

C 0165 

C FIGURE OUT THE TOTAL NO. OF ROWS TO BE PLOTTED 0166 

C 0167 

DO 50 IXY*1,NY 0168 

50 NROWS * XMAXOF(NROWS,LYV( IXY)+IXSTRV( IXYJ-i) 0169 

IF (NROWS) 9999,9999,100 0170 

C 0171 

C BEGIN PROCESSING FOR NEXT LINE OF OUTPUT 0172 

C START BY CLEARING THE STAGING AREA 0173 

C 0174 

100 CALL SETKV(6H ,131, STAGE) 0175 

C 0176 

C THEN SET UP CHARACTERS FOR THE YS 0177 

C 0178 

DO 170 IXY=1,NY 0179 

C 0180 

C CHECK IF THIS ROW CONTAINS THE VECTOR 0181 

C 0182 

IXSTRT * IXSTRV(IXY) 0183 

IF (IXSTRT-IXROW) 110,120,170 0184 

110 IF (IXR0W-IXSTRT-LYV(IXY)+1) 120,120,170 0185 

C 0186 

C OK, IT DOES 0187 

C 0188 

C (32561*C0MM0N BASE 10, =77461 BASE 8) 0189 

C 0190 

120 IXCOM - 32562-LGCYVUXY)~IXSTRT«-IXR0W 0191 

Y * COM( IXCOM) 0192 
ASSIGN 130 TO IEXCON 0193 
GO TO 700 0194 

130 IF (IXSTAG) 170,170,140 0195 

C 0196 
C SET THE CHARACTER (OR * IF A REPEAT) BUT IGNORE IF CHARACTER IS 8LANK 0197 

C 0198 

140 IF (YSMBVUXY)-SPACES) 145,170,145 0199 

145 IF (STAGEUXSTAG)-SPACES) 150,160,150 0200 

150 STAGEt IXSTAG) « 1H« 0201 

GO TO 170 0202 

160 STAGE! IXSTAG) * YSMBViIXY) 0203 

170 CONTINUE 0204 

C 0205 

C BEGIN PROCESSING OF HORIZONTAL LINES IF ANY 0206 

C 0207 

200 IF (NHL) 400,400,210 0208 

210 DO 260 IXHL=UNHL 0209 

Y » HLINVUXHL) 0210 
ASSIGN 230 TO IEXCON 0211 
GO TO 700 0212 

230 IF (IXSTAG) 260,260,240 0213 

C 0214 

C DONT DISTURB A PREVIOUS SETTING 0215 

C 0216 

240 IF (STAGE(IXSTAG)-SPACES) 260,250,260 0217 

250 STAGE ( I XSTAG ) = HLSMBV(IXHL) 0218 

260 CONTINUE 0219 

C 0220 

C FINALLY PRINT THE LINE 0221 

C 0222 
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C PRINT FIRST OFF-LINE IF REQUESTED 0223 

C 0224 

400 IF (ITAPE) 420*420,410 0225 

410 WRITE OUTPUT TAPE ITAPE, FMT, ARG, (STAGEC I ) , I=1,NC0LS ) 0226 

C 0227 

C AND THEN ON-LINE IF REQUESTED 0228 

C 0229 

420 IF (ISENSE-6) 430,430,450 0230 

430 IF (SWITCHFUSENSE)) 460,460,450 0231 

450 PRINT FMT,ARG,(STAGE(I),I=1,NC0LS> 0232 

C 0233 

C INCREMENT ARG AND GO BACK FOR MORE UNLESS DONE 0234 

C 0235 

460 IF (ZFAFXD) 480,470,480 0236 

470 I ARG * I ARGi-I ARGD 0237 

GO TO 490 0238 

480 ARG = ARG+ARGDEL 0239 

490 IXROW * IXROW+l 0240 

IF (IXROW-NROWS) 100,100,9999 0241 

C 0242 

C INTERNAL ROUTINE TO CONVERT A Y TO AN IXSTAG 0243 

C 0244 

C ENTER AT 700, LEAVE THRU IEXCON 0245 

C 0246 

C Y 38 YBOT GIVES IXSTAG * 1 0247 

C Y = YTOP GIVES IXSTAG = NCOLS 0248 

C 0249 

700 IXSTAG = 0 0250 

FIXSTG » 1.0+(Y-YB0T)*SCALE 0251 

IF (FIXSTG) 730,730,710 0252 

710 IF (FIXSTG-. 5-FNC) 720,730,730 0253 

720 IXSTAG » RNDFIF1XSTG) 0254 

730 GO TO IEXCON, ( 130,230) 0255 

C 0256 

C EXIT 0257 

C 0258 

9999 RETURN 0259 

END 0260 
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» PLTVS1 (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO. 

» LABEL 

IPLTVSl 

SUBROUTINE PLTVS1 ( I TAPE , I SENSE, ARGLO, ARGDEL , ZFAFXD, NCOLS, ZFZERS, 
1 RMSSEP *S,LX,ZFLIST,VMATRX, IDIMEN,NX) 



- ABSTRACT 

TITLE - PLTVS1 

PRINTER PLOT OF A SET OF EQUAL LENGTH VECTORS 

PLTVS1 MAKES A SIMULTANEOUS PRINTER PLOT, OFF-LINE WITH 
ON-LINE OPTION, OF UP TO 35 EQUAL LENGTH VECTORS* THE 
VECTORS BEING ALIGNED AND ORIENTED FOR-VIEWING WITH THE 
PAGE ROWS VERTICAL, USING ONE ROW FOR EACH VECTOR INDEX. 
THE VECTORS ARE SPECIFIED EITHER BY A LIST OR AS THE 
COLUMNS OF A MATRIX. PRIOR TO PLOTTING PLTVS1 SCALES 
ALL THE VECTORS SO THAT EACH HAS UNIT RMS VALUE, SO THAT 
THEIR ZERO LEVELS WILL BE EQUALLY SPACED ON THE PRINTED 
PAGE, THE SPACING BEING CONTROLLED BY USER (MAY BE ZEROl , 
AND SO THAT THE COMPLETED GRAPH WILL JUST FIT INTO A 
SPECIFIED NUMBER OF COLUMNS WITHOUT LOSS OF ANY DATA 
VALUES. THE VECTORS ARE UN— SCALED AFTER THE PLOTTING. 
A TABLE GIVING CHARACTER ASSIGNMENTS AND EXTREMAL VALUES 
OF EACH VECTOR IS PRINTED PRIOR TO THE PLOT. FURTHER 
CONTROLS 8Y THE USER INCLUDE THE NUMERICAL LABELLING OF 
THE ROWS, THE INCLUSION OR EXCLUSION OF ZEftO-LiVEL LINES* 
THE OMISSION OF THE PLOTTING OF SELECTED DUMMY VECTORS 
FOR SPACING PURPOSE, AND THE OPTION OF ON-LINE MONITORING 
UNDER SENSE SWITCH CONTROL. 



LANGUAGE 
EQUIPMENT 



STORAGE 
SPEED 



AUTHOR 



FORTR AN-I I SUBROUTINE 

709,7090,7094 MAIN FRAME PLUS ONE TAPE DRIVE AND/OR THE 

ON-LINE PRINTER, PLUS ONE SENSE SWITCH HOPTIONALI 
817 REGISTERS 

PLOTS 5 VECTORS OF LENGTH 33 OVER 50 COLUMNS IN 
ABOUT .42 SECONDS ON THE 7094 . FOR 15 VECTORS 
OF LENGTH 50 OVER 100 COLUMNS IT TAKES ABOUT 1.1 
SECONDS. 

S.M.SIMPSON, MARCH 1964 



USAGE 

TRANSFER VECTOR CONTAINS ROUTINES - BOOST, DPRESS, MAXSN, MJNSN, 

MULPLY,PLOTVS,RMSDEV^ SETKS, 
SETKVS, SETVEC, VARARG, XSAME,XSTLIN 
AND FORTRAN SYSTEM ROUTINES - (FID, (STH),XLOC 

FORTRAN USAGE 

CALL PLTVSKITAPE, ISENSE, ARGLO, ARGDEL, ZFAFXD, NCOLS, ZFZERS, 
1 RMSSEP, S, LX, ZFLIST, VMATRX, IDIMEN, NX) 

OR 

CALL PLTVSKITAPE, ISENSE, ARGLO, ARGDEL* ZFAFXD, NCOLS* ZFZERS, 
1 RMSSEP, S, LX, ZFLIST, XI, X2, X3, . . . , XNXJ! 



INPUTS 
ITAPE 

ISENSE 



ARGLO 



IS LOGICAL TAPE NUMBER FOR OUTPUT. 
SHOULD LIE IN CLOSED RANGE 1 TO 20 



(NOT CHICKED! « 



GRTHN- 7 GIVES CONTINUOUS ON-LINE OUTPUT 

LSTHN- 0 SUPPRESSES ALL ON-LINE OUTPUT. 

= 1,2,3,4,5, OR 6 RESULTS IN ON-LINE OUTPUT WHILE AND 

AND ONLY WHILE THE CORRESPONDING SENSE SWITCH IS 

DEPRESSED (ON). 

IS THE NUMERICAL VALUE BY WHICH TO LABEL THE FIRST OUTPUT 
ROW. 



0392 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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ARGOEL 



ZFAFXD 



NCOLS 



ZFZERS 



RMSSEP 



S(I) 



LX 



ZFLIST 



C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

C OUTPUTS 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

C EXAMPLES 
C 

C 1. INPUTS 



IS THE NUMERICAL INCREMENT BETWEEN LABELL INGS OF 
SUCCESSIVE ROWS • 

0.0 IMPLIES ARGLO ANO ARGDEL ARE FIXED POINT. 
NOT= 0.0 IMPLIES THEY ARE FLOATING POINT. 

FIXED LABELS ARE PRINTED IN COLUMNS 2 THRU 5 
FORMAT ( 14 ) ) • 

FLOATING LABELS ARE PRINTED IN COLUMNS 2 THRU 13 
(F0RMAT(E12.5)). 

SPECIFIES THAT THE PLOTTING FIELD SHALL OCCUPY COLUMNS 

L+l THRU L+NCOLS WHERE L » 5 OR 13 ACCOROING TO 
ZFAFXD. 

SHOULD NOT EXCEED NO. COLUMNS ON PRINTER - L (NOT 
CHECKED) . 

0.0 REQUESTS THAT ZERO LEVELS OF THE VECTORS BE 
PLOTTED AS STRAIGHT LINES. 
NOT= 0^0 REQUESTS SUPPRESSION OF ZERO LEVEL PLOTS. 

SPECIFIES THE PLOTTING SEPARATION BETWEEN ZERO LEVELS OF 
THE SUCCESSIVE VECTORS IN UNITS OF THEIR COMMON 
(AFTER SCALING) ROOT-MEAN-SQUARE VALUE OF 1*0 * 
EXAMPLE - AN RMSSEP OF 2/. 707 WOULD CAUSE THE 
PLOTS OF COS(W) AND -COSIfW) TO GRAZE 
EACH OTHER AT ODD MULTIPLES OF PI* 
MUST BE GRTHN= 0.0 (NOT CHECKED)* 

1=1. ..300 MUST BE AVAILABLE FOR SCRATCH. 

IS THE COMMON LENGTH OF THE VECTORS* 
MUST EXCEED ZERO (NOT CHECKED). 

NOT= 0.0 SIGNIFIES THAT THE CALLER IS USING THE FIRST OF 
THE TWO POSSIBLE FORMS OF CALLING SEQUENCE ^INVOLVING 
VMATRX, IDIMEN, NX) IN WHICH THE VECTORS TO BE 
PLOTTED ARE THE COLUMNS OF A MATRIX. 

0.0 SIGNIFIES THE USE OF THE SECOND FORM OF CALLING 
SEQUENCE IN WHICH THE VECTORS ARE SPECIFIED BY A LIST. 



VMATRXI I , J) 1=1. ..LX, J=1...NX CONTAINS, FOR ZFLIST 
THE NX VECTORS 

XK1...LX) = VMATRX(1.**LX,1) 
X2Q...LX) = VMATRX< l*.*LX,2) 
ETC. 

XNXU.*.LX) = VMATRX(1.*.LX,NX) 



NOT* 



0.0, 



IDIMEN 



NX 



X1,X2,*.« 



IS THE CALLER'S DIMENSION OF THE INDEX 

VMATRX ( I » J ) • 
MUST BE GRTHN- LX (NOT CHECKED). 



I IN 



MUST BE GRTHN= 1 AND LSTHN* 35 (NOT CHECKED). 

,XNX ARE, FOR ZFLIST *0.0, THE NX VECTORS TO BE 
PLOTTED* 



A TABLE GIVING MAXIMA ANO MINIMA OF THE VECTORS PLUS 
THEIR PLOTTING CHARACTERS IS PRINTED (OFF-LINE ONLY) 
FOLLOWED BY A PAGE RESTORE AND THE PLOT PRDPFR. THE 
VECTORS ARE PLOTTED WITH ZERO LEVELS SEPARATED (IF 
RMSSEP GRTHN 0.0) SO THAT XI IS CLOSEST TO TOP OF 
PLOT (HIGH COLUMN NUMBERS) AND XNX CLOSEST TO BOTTOM. 
THE CHARACTERS FOR XI, X2,.*. ARE TAKEN SUCCESSIVELY 
FROM THE LIST 1, 2 , . . . , 9, A,B, . . * , Z. IF ANY X VECTOR 
HAS NOTHING BUT ZERO ELEMENTS ITS PLOTTING IS SUPPRESSED 
BUT THE SUCCEEDING VECTOR IS SPACED AS THOUGH THE ZERO 
VECTOR WERE PRESENT. ZERO LEVEL LINES (IF REQUESTED! ARE 
PLOTTED WITH PERIODS, AND INTERSECTIONS OF CURVES ARE 
INDICATED BY ASTERISKS. 



- THE FOLLOWING SEQUENCE SETS UP A MATRIX OF 5 VECTORS 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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WHICH ARE COSINE WAVES OF VARIOUS FREQUENCIES, EXCEPT 
THAT TWO SPIKES ARE THROWN IN THE SECOND AND THIRD 
VECTORS, AND THAT THE FOURTH VECTOR IS ZEROED TO 
ILLUSTRATE SPACING. 

DIMENSION V<50,5),X1(50),X2<50),X3(50*,X4C501, 
1 X5(50),S(300) 

EQUIVALENCE ( XI , V) , i X2, V( 51) , I X3 , V ( 101 ) 
1 (X4,V<151)),X5,V<201)) 

DO 10 J=l,5 

TENTH J = .1*FL0ATF1J) 

DO 10 1=1,33 
10 VU,J) * COSF ( TENTHJ»FLGATF< 1-1 ) ) 

V<5,3) = 7.0 

VU5,2) » -10.0 

DO 20 1*1,33 
20 V(I,4) » 0.0 

USAGE - CALL PLTVS 1 < 2 , 1 ,0, 1, 0, 50, I . , 1.5, S, 33» 1. , V, 50%5) 

CALL PLTVSK 2, 1*0, 1,0,50,0. , 1.5, S, 33,0., XUX2IX3, 
1 X4,X5) 

OUTPUTS - THE TWO CALLS LEAD TO IDENTICAL OUTPUT ON LOGICAL 2 
(ON-LINE MONITORING WITH SENSE SWITCH 1), EXCEPT THAT 
ZERO LfVELS ARE PLOTTED ONLY FOR THE SECOND CALL. IN 
EACH CASE A 5-LINE TABLE, GIVING VECTOR NUMBER, 
CHARACTER, MAX VALUE AND ITS INDEX, MIN VALUE AND ITS 
INDEX, IS PRINTED IN COLUMNS 2 THRU 83 PRECEDING THE 
THE GRAPH INCLUDING THE ZERO LEVELS IS SHOWN 



PLOT. 
BELOW. 



0 
1 
2 
3 
4 
5 
6 
7 
8 
9 
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 



.2 
.2 

2 

2 
2. 
2. 



2. 
2. 

2 



1 
21 



• 12 
.12 
.12 

1 2 
1 2 
1 2 



PROGRAM FOLLOWS BELOW 



USE OF SPACE VECTOR 



S(1...35) = SUYSM...) = 

= 1H1,1H2,...,1H9,IHA, 1HB, • • • , 1HZ 
S(40...50) * XLO€F(ITAPE),(ISENSE),...,(ZFLIST) 



0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
0197 
0198 
0199 
0200 
0201 
0202 
0203 
0204 
0205 
0206 
0207 
0208 
0209 
0210 
0211 
0212 
0213 
0214 
0215 
0216 
0217 
0218 
0219 
0220 
0221 
0222 
0223 
0224 
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C S(51...85) = SiJLOC.*.) = XLOCF(Xl),(X2),.i.,(XN),0.#. IF ZFLIST*0 0225 

C = XLOCF(VMATRX),( IDIMEN),0,.«. IF ZFLIST 0226 

C NOT a 0 0227 

C S(91..*125) * SULYV*..) = LX,LX,*.. 0228 

C SU31...165) = SUSTR...) » 1,1,1,... 0229 

C S(17i.*.205) * St JHLN) • • • ) * ZER( XI ) ,ZER( X2) ,ZERISXN ) TRANSLATED 0230 

C SI211...245) * StJRMS...) « RMS (XI) , RMS ( X2 ),..•, RMS ( XN ) ORIGINAL 0231 

C S(251.*.275) » SUHSM...) * 1H., 1H., ... 0232 

C 0233 

DIMENSION S12),C(2> 0234 

COMMON C 0235 

C 0236 

C SET UP A LOCATION VECTOR 0237 

C 0238 

CALL VARARGCSI40)) 0239 

GO TO 10 0240 

9999 RETURN 0241 

C 0242 

C SET UP INDICES IN SPACE VECTOR S, SET UP SYMBOL VECTOR, 0243 

C LENGTH VECTOR, STARTING POINT VECTOR, L, SEP . 0244 

C 0245 

10 CALL SETKS(1,JYSM, 251,JHSM, 51,JL0C, 91„JLYV, 131,JSTR^ 0246 

1 171, JHLN, 2ll,JRMS, LX,L, RMSSEP, SEP) 0247 

CALL SETVEC(S( JYSM),1HI,1H2,1H3, 1H4, 1H5, 1H6, 1H7, 1H8* 1H9,I1HA% 1HB , 0248 

1 1HC,2HD,IHE,1HF,IHG,1HH,1HI,1HJ,1HK,1HL, 1HM, 1HN, 1IH0, 1HP, 0249 

2 1HQ,1HR,IHS,1HT,1HU,1HV,1HW,1HX,1HY,1HZ) 0250 
CALL SETKVS(L,35,S( JLYV), I , 35, Si JSTR ) , 1H.,35,S( JHSMl) 0251 

C 0252 

C SET N FOR THE CASE OF A LIST 0253 

C 0254 

N = -1 0255 

30 N * N+l 0256 

IF (S(N+51)) 30,40,30 0257 

C 0258 

C RECOMPUTE THE LOCATION VECTOR AND RESET N FOR A MATRIX INPUT 0259 

C 0260 

40 IF (ZFLIST) 50,60,50 0261 

50 N - NX 0262 

CALL XSTLI N(iXLGCF(VMATRX),~ 1 DIMEN,N, SIJLOC ) ) 0263 

C 0264 

C CHECK SOME ITEMS 0265 

C (DUMMY AT PRESENT) 0266 

C 0267 

60 CONTINUE 0268 

C 0269 

C NOW BEGIN SCAN OF VECTORS 0270 

C 0271 

100 BORLO » 0.0 0272 

BORHI * 0.0 0273 

EDGE » .1 0274 

DO 150 IXX*1,N 0275 

C 0276 

C FIND IXC * INDEX WRT COMMON OF X SUB IXX 0277 

C 0278 

ITEMP * JLOC+IXX-1 0279 

TEMP * SUTEMP) 0280 

IXC = 32562-XSAMEF(TEMP) 0281 

C 0282 

C FIND RMS OF X AND STORE IN S ( JRMS + I XX- I ) 0283 

C 0284 

CALL RMSDEVI C( IXC) ,L,0.,RMS) 0285 

ITEMP = JRMS+IXX-1 0286 

Si ITEMP) = RMS 0287 

C 0288 

C FIND THE CHARACTER USED FOR THIS VECTOR 0289 

C 0290 

ITEMP = JYSM+IXX-1 0291 

CHAR ■ S( ITEMP) 0292 

C 0293 

C IF THE RMS VALUE IS ZERO MAKE A 0294 

C SPECIAL COMMENT AND SKIP TO NEXT VECTOR CHANGING CHARACTER TO BLANK 0295 

C 0296 

IF (RMS) 120,120,130 0297 

120 WRITE OUTPUT TAPE ITAPE, 122, IXX 0298 

122 FORMAT ( 8H VECTOR ,I2,39H IS IDENTICALLY ZERO, PLOTTING OMITTED.) 0299 
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B SUTEMP) * 606060606060 0300 

GO TO 150 0301 

C 0302 

C OTHERWISE FIND EXTREMAL VALUES AND PRINT THEM 0303 

C 0304 

130 CALL MAXSN<fc,C( IXC),XMAX,IXMAX) 0305 

CALL MINSN(L,CUXC),XMIN,IXMIN) 0306 

WRITE OUTPUT TAPE ITAPE, 135» IXX,CHAR, IXMAX^XMAX* IXMIN, XilN 0307 

135 FORMAT (8H VECTOR , 12, 12H, CHARACTER ,A1,13H, HAS MAX AT ,14, 0308 

1 3H * ,E12.5,9H, MIN AT ,I4,3H * ,E12.5) 0309 

C 0310 

C THEN SCALE XMAX XMIN AND THE VECTOR TO HAVE UNIT RMS 0311 

C 0312 

SCALE * 1.0/RMS 0313 

XMAX * SCALE*XMAX 0314 

XMIN * SCALE*XMIN 0315 

CALL MULPLYOCUXC), L, SCALE, C( IXC1) 0316 

C 0317 

C UPDATE THE TRIAL VALUES OF BORLO, BORHI 0318 

C 0319 

TEMP « MAX1F!0.#-XMIN) 0320 

BORLO * MAX1F(B0RL0,TEMP-SEP»FL0ATF(N-IXX) ) 0321 

TEMP » MAX1F(0.,XMAX) 0322 

BORHI « MAX1F<B0RHI,TEMP-SEP»FLOATF(IXX-1)) 0323 

C 0324 

C END OF FIRST VECTOR SCAN 0325 

C 0326 

150 CONTINUE 0327 

C 0328 

C WHEN DONE MAKE A CHECK THAT ALL VECTORS ARENT ZERO 0329 

C 0330 

IF ( BORLO+BORHI > 160,160,170 0331 

160 WRITE OUTPUT TAPE ITAPE,165 0332 

165 FORMAT C43H ALL VECTORS VANISH, NO PLOTTING WILL OCCUR) 0333 

GO TO 9999 0334 

C 0335 

C NOW THAT WE HAVE BORLO AND BORHI, THE MEANS CAN BE ADJUSTED* 0336 

C AND THE ADDED CONSTANTS INSERTED INTO SiJHLN*..) 0337 

C 0338 

170 DO 180 IXX * UN 0339 

ITEMP * JLOC+IXX-1 0340 

TEMP * SUTEMP) 0341 

IXC » 32562-XSAMEFITEMP) 0342 

CONST = EDGE+B0RL0+SEP*FL0ATF(N-1XX ) 0343 

CALL BOOST (C ( I X€ ) , L»CONST ,C ( IXC) ) 0344 

ITEMP = JHLN+IXX-i 0345 

SUTEMP) = CONST 0346 

180 CONTINUE 0347 

C 0348 

C YTOP AND YBOT CAN Bf SET NOW 0349 

C 0350 

YBOT « 0.0 0351 

YTOP « EDGE* BORLO+SEP»FL OAT F ( N-l ) +BORH I +EDGE 0352 

C 0353 

C SKIP TO NEW PAGE 0354 

C 0355 

WRITE OUTPUT TAPE ITAPE,200 0356 

200 FORMAT ( 1H1 ) 0357 

C 0358 

C SET NHL ACCORDING TO ZFZERS 0359 

C 0360 

NHL » 0 0361 

IF (ZFZERS) 220,210,220 0362 

210 NHL = N 0363 

C 0364 

C SET FMTARG ACCORDING TO ZFAFXO 0365 

C 0366 

220 FMTARG * 2HI4 0367 

IF (ZFAFXD) 230,240,230 0368 

230 FMTARG * 5HE12.5 0369 

C 0370 

C THEN GO PLOT 0371 

C 0372 

240 CALL PLOTVSU TAPE, I SENSE, S< JLOC),S( JYSM),S( JLYV),S< JSTR),N, 0373 
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1 ARGLC,ARGOEL,ZFAFXD,FMTARG,NCGLS»YBOT,YTOP,S( JHLN) t S ( ,*JHL ) 0374 

C 0375 

C THEN Rt SCALE THE VECTORS TO THEIR ORIGINAL VALUES 0376 

C 0377 

DO 250 IXX*1,N 0378 

I TEMP = JLOC+IXX-1 0379 

TEMP = S(ITEMP) 0380 

IXC * 32562-XSAMEF(TEMP) 0381 

CONST = EDGE+BCRLO+S£P*FLOATF(N-IXX) 0382 

CALL DPRESSICt IXC) ,L,CONST,C( IXCU 0383 

I TEMP = JRMS+IXX-1 0384 

RMS * S(IIEMP) 0385 

CALL MULPLYICUXC),L,RMS,C( IXC) ) 0386 

250 CONTINUE 0387 

C 0388 

C GO EXIT 0389 

C 0390 

GO TO 9999 0391 

END 0392 
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* PLURNS < SUBROUTINE) 9/29/64 LAST CARO IN OfCK IS NO. 0246 
« FAP 0001 
♦PLURNS 0002 

COUNT 200 0003 
LBL PLURNS 0004 

ENTRY PLURNS < Al, A2, AN, Bl , B2 f BNt ,Zt *Z2*. .* ,ZN) 0005 

« OR 0006 

* (A1,A2,..., ANA, STOP, Bl , B2, • • *, BNB t STOP ....... ♦ 0007 

* Z1,Z2,...,ZNZ) 0008 

* 0009 

* -ABSTRACT 0010 

* 0011 

* TITLE - PLURNS 0012 
» PLURALIZE THE NEXT SUBROUTINE 0013 
» 0014 

* PLURNS IS A VARIABLE-LENGTH-CALLING SEQUENCE SUBROUTINE 0015 

* WHOSE ARGUMENTS ARE DIVIDED INTO EQUAL LENGTH GROUPS OR 0016 

* INTO ARBITRARY LENGTH GROUPS SEPARATED BY A FENCE-TYPE 0017 

* ARGUMENT. EACH SUCH GROUP REPRESENTS A SET OF ARGUMENTS 0018 

* TO BE ASSOCIATED WITH THE SUBROUTINE WHOSE NAME APPEARS 0019 

* IN A CALL STATEMENT IMMEDIATELY FOLLOWING THE CALL PLURNS 0020 
» STATEMENT. PLURNS THEN CALLS THAT SUBROUTINE ©NCE FOR 0021 

* EACH OF THESE GROUPS. THE CALL SUBROUTINE STATEMENT HAS 0022 

* EITHER ONE ARGUMENT OR NO ARGUMENTS* IF ONE, AND 0023 

* GREATER THAN ZERO, EQUAL LENGTH GROUPS ARE ASSWMEDi WITH 0024 
» LENGTH « ARGUMENT. IF NONE, OR ONE WITH VALUE 04 THE 0025 
» FENCE FORMAT IS ASSUMED. 0026 

* 0027 

* LIMITATION - NONE OF THE ARGUMENTS IN A GROUP MAY BE 0028 

* EXPRESSIONS INVOLVING OUTPUTS OF A PREVIOUS GROUP 0029 

* EXCEPT FOR PURE EQUIVALENCES. 0030 
» 0031 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN-I I COMPATIBLE) 0032 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0033 

* STORAGE - 73 RFGI STERS 0034 

* SPEED - 0035 

* AUTHOR - S.M. SIMPSON, OCTOBER 1963 0036 
» 0037 
» USAGE 0038 

* 0039 
» TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0040 
» AND FORTRAN SYSTEM ROUTINES - (NONE) 0041 

* 0042 
» FORTRAN USAGE FOR SUBROUTINES WITH FIXED, NON-ZERO ARGUMENT COUNT * N 0043 
» 0044 
» CALL PLURNS (A1,A2,..., AN, B1,B2, ...♦BN t ......,Zl»Z2»...»ZN) 0045 

* CALL SUBRU(N) 0046 

* 0047 

* IS EQUIVALENT TO 0048 
» 0049 

* CALL SUBRU( A1,A2,...,AN) 0050 

* CALL SUBRU(B1,B2,...,BN) 0051 

* ETC 0052 
» CALL SUBRU(Z1,Z2,..*,ZN) 0053 
« 0054 
» FORTRAN USAGE FOR SUBROUTINES WITH VARIABLE OR ZERO ARGUMENT COUNTS 0055 

* EITHER 0056 
» CALL PLURNS (A1,A2,.«., ANA, STOP, 81, B 2* * • BNB, STOP, . *»•••» Zl*Z2t 0057 

* ...#ZNZ) 0058 
» CALL SUBRU(O) 0059 
» OR 0060 
» CALL PLURNS (A1,A2,..., ANA, STOP, B1,B2, a.., BNB* STOP,. ...... Zl,Z2, 0061 

* ...»ZNZ) 0062 

* CALL SUBRU 0063 

* 0064 

* WHERE STOP = OCT 777777712345 0065 

* 0066 

* IS EQUIVALENT TO 0067 
» 0068 

* CALL SUBRUUl, A2,...,ANA) 0069 

* CALL SUBRU(B1,B2,...,BNB) 0070 

* ETC 0071 

* CALL SUBRU(Z1,Z2,...,ZNZ) 0072 

* 0073 
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• WHERE ONE OR MORE OF THE ARGUMENT COUNTS NA,NB,.».,NZ MAY BS ZEftO* 0074 

• 0075 
» IMPORTANT LIMITATION - IF X IS AN OUTPUT FROM ONE CALL SUBRU AND Y 0076 

• IS AN INPUT TO A SUCCEEDING CALL SUBRU, EQUIVALENCE (Y,X) IS THE ONLY 0077 

• MANNER IN WHICH THE Y EXPRESSION MAY INVOLVE THE X EXPRESSION* THUS* 0078 
« IF X=I THEN Y*AI!) IS ILLEGAL, Y=2»I IS ILLEGAL, ETC* 0079 

• 0080 

• 0081 

• EXAMPLES 0082 

• FOR ILLUSTRATION WE USE THE FOLLOWING SIMPfcE SUBROUTINES 0083 

• SUBROUTINE ADDCX, Y,SUMXY) 0084 

• SUMXY=X+Y 0085 

• RETURN 0086 

• END 0087 

• AND 0088 

• SUBROUTINE TELL 0089 

• WRITE OUTPUT TAPE 2,5 0090 
» 5 F0RMATC21H TELL HAS BEEN CALLED) 0091 
» RETURN 0092 
» END 0093 

• 0094 

• !• WITH SPECIFIED ARGUMENT COUNT 0095 

• INPUTS - XI#X2,X3,X4 « l.,2.,3.,4* Y1,Y2,Y3,Y4 » 2.,4„,6.,S» 0096 

• USAGE - CALL PLURNS < XI , Y 1, SUM1,X2, Y2, SUM 2, X3^Y3, SUM3) 0097 
» CALL ADD( 3) 0098 
» CALL PLURNS (X4,Y4, SUM4) 0099 

• CALL ADD( 3 ) 0100 

• OUTPUTS - SUM1,SUM2,SUM3,SUM4 = 3.,6*,9.,12« 0101 
» 0102 

• 2. WITH ZERO OR UNSPECIFIED ARGUMENT COUNT 0103 
« INPUTS - SAME AS EXAMPLE 1, PLUS STOP«OCT 777777712345 0104 
» USAGE - CALL PLURNSi X 1, Y U S1A, STOP, X2, Y2, S2A >STOP , 0105 

• X3,Y3,S3A) 0106 

• CALL ADD(O) 0107 

• CALL PLURNS<X4,Y4,S4A) 0108 

• CALL ADD(O) 0109 

• CALL PLURNS ( X1,Y I, SIB, STOP, X2,Y2, S2B^ STOP , 0110 

• X3,Y3,S3B) 0111 

• CALL ADD 0112 

• CALL PLURNS(X4,Y4,S4B) 0113 
» CALL ADD 0114 
» OUTPUTS - SIA=S1B*3. S2A=S2B*6. S3A=S3B*9, S4A±54B*il2* 0115 
» 0116 

• 3m BEHAVIOUR ON A NO— ARGUMENT SUBROUTINE 0117 

• INPUTS - STOP - SAME AS EXAMPLE 2. 0118 

• USAGE - CALL PLURNS ( STOP , STOP ) 0119 

• CALL TELL ( 0 ) 0120 

• CALL PLURNS 0121 

• CALL TELL ( 0 ) 0122 

• OUTPUTS - THE FOLLOWING 4 LINES 0123 

• TELL HAS BEEN CALLED 0124 

• TELL HAS BEEN CALLED 0125 

• TELL HAS BEEN CALLED 0126 
« TELL HAS BEEN CALLED 0127 
» WILL BE PRINTED OFF-LINE FROM LOGICAL 2 0128 
» 0129 
» 4* USAGE - CALL PLURNS ( STOP, STOP) 0130 
» CALL TELL 0131 
» CALL PLURNS 0132 

• CALL TELL 0133 

• OUTPUTS - SAME AS EXAMPLE 3. 0134 

• 0135 
« PROGRAM FOLLOWS BELOW 0136 
» 0137 

• 0138 
» NO TRANSFER VECTOR 0139 

HTR 0 XR1 0140 

HTR 0 XR2 0141 

HTR 0 XR4 0142 

BCI 1, PLURNS 0143 

» ONLY ENTRY. PLURNS IA1 , A2, AN, Bl, B2, » . . , BN, • , ZI, Z2, . «. ,ZN) 0144 

• FOLLOWED BY CALL SUBRU(N) N=NARGS 0145 

• 0146 

• OR (CASE 2) PLURNSC A 1 , A2, • • • , ANA, STOP, Bl, B2» • . . t BNB, STOP, •«»•••» 0147 
» Z1,Z2,..*,ZNZ) 0148 
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PLURNS SXD 


PLURNS-2,4 


0150 


SXD 


PLURNS-3, 2 


0151 


SXD 


PLURNS-4,1 


0152 


* SCAN DOWN 


FOR TSX $SUBRU,4 


0153 


CAL CAL 


1,4 


0154 


STA 


TRAOUT (ANTICIPATORY SETTING) 


0155 


ANA 


AMASK 


0156 


LAS 


TSXZ4 


0157 


TRA 


*+2 


0158 


TXI 


G0TSUB f 4,-l GOT IT (NOW AT 0,4) 


0159 


* NOT YET 




0160 


TXI 


CAL, 4,-1 


0161 


» THEN CHECK 


FOR CASE 1, OR CASE 2 


0162 


GOTSUB TSX 


TSXZCK,1 CHECK LOC(TSX $SUBRU,4)+1 


0163 


TRA 


SXAZIF CASE 2 IF NARGS UNSPECIFIED 


0164 



* CASE 1, 



CLEAR ZIFCAI, SET NARGS BUMPER, SET EXIT TO 

LOCUSX $SUBRU,4)+2 (HOWEVER, SWITCH TO CASE 2 IF NARGS*0) 



XR2 IS USED TO FIND 



• LOOP BEGINS. X*4 IS USED TO FOOL THE SUBROUTINE* 

* THE E1S10 OF ITS CALLING SEQUENCE, FOR LINKAGE. 
NEXT ZET ZIFCA1 

TRA SXA2 

» FOR CASE 1. MOVE XK4 TO XR2 AND BUMP IT BY NARGS. GO TO SUBROUTINE* 
PXA 0,4 
PAX 0,2 
TXI1 TXI SETLNK,2,»* ** =* -NARGS 

* FOR CASE 2, USE XR4 TO SCAN FOR STOP OR END OF SEQUENCE, BUI SAVE XR4 

♦ FOR LATER RESTORATION. 
SXA2 SXA AXT2,4 

TSXZC2 TSX TSXZCK,1 
TRA PXA2 



FIRST CHECK FOR ANOTHER ARGUMENT 
NO, TERMINATE SCAN 
* IF 1,4 IS AN ARGUMENT, CHECK TO SEE IF THE ARGUMENT IS STOP. 



CAL* 

LAS 

TRA 

TRA 

TXI 



1,4 

STOP 

*+2 

PXA2 

TSXZC2*4,-1 



YES, TERMINATE SCAN 
NO, TRY AGAIN 



» AFTER SCAN, MOVE NEW XR4 TO XR2 AND RESTORE OLD XR4 



PXA2 PXA 
PAX 

AXT2 AXT 



0,4 
0,2 
**,4 



•* 3 XR4 TO FOOL SUBROUTINE 



* SET RETURN LINKAGE IN 1,2 
SETLNK CLA 1,2 

STO SAVNXT 
CLA TRABAK 
STO 1,2 

• GO OPERATE THE SUBROUTINE 



SXA 

TRAOUT TRA 



BACK, 2 



** * A( TTR SUBRU) 



• AFTERWARDS , RESTORE XR4 TO OLD XR2, RESTORE 1,4 



BACK 



AXT 
CLA 
STO 



** * XR2 BEFORE SUBROUTINE 



SAVNXT 
1,4 



♦ EXIT IF 1,4 IS NOT AN ARGUMENT 

TSX TSXZCKU 

TRA LEAVE NO 

» IF MORE TO DO, INDEX XR4 BY OICASE 1) OR —1 ( CASE 2) 
» AND RETURN FOR NEXT ARGUMENT SEQUENCE. 

ZET ZIFCAi 

TXI NEXT,4#-i CASE2 

TRA NEXT CASE1 

* EXIT 

LEAVE LXD PLURNS-3, 2 



0165 
0166 



STZ 


ZIFCAI 




0167 


TXI 


*+i,4,-l 


(ANTICIPATE A SWITCH) 


0168 


CLA* 


0,4 


NARGS 


0169 


PDC 


0,2 


—NARGS 


0170 


TXL 


SXAZIF*2,0 


(SWITCH TO CASE 2) 


0171 


SXD 


TXU,2 


OK, NON-ZERO NARGS 


0172 


TRA 


SXAAXT 




0173 


* CASE 2. SET ZIFCAI NON 


ZERO, SET EXIT (VARIABLE) 


0174 


SXAZIF SXA 


ZIFCAI, 4 




0175 


SXAAXT SXA 


AXTX,4 




0176 


* INITIALIZE 


LOOP BY RESTORING ORIGINAL XR4 


0177 


LXD 


PLURNS-2,4 




0178 



0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
0197 
0198 
0199 
0200 
0201 
0202 
0203 
0204 
0205 
0206 
0207 
0208 
0209 
0210 
0211 
0212 
0213 
0214 
0215 
0216 
0217 
0218 
0219 
0220 
0221 
0222 
0223 
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LXD 


PLURNS-4,1 






0224 


AXTX AXT 


**, 4 


»* s 


~(A(TSX $SUBRU,4)+1) OR 


0225 


* 






-A(TSX $SUBRU,4) 


0226 


TRA 


1,4 






0227 


» INTERNAL SUBROUTINE TO CHECK IF 


1,4 IS A TSX X,0 


0228 


• LINKAGE WITH XR1 OESTROYS 


AC 


0229 


* RETURNS 


TO 1,1 IF NOT 






0230 


• 


2*1 IF SO 






0231 


TSXZCK CAL 


1,4 






0232 


ANA 


AMASK 






0233 


LAS 


TSXZ 






0234 


TRA 


*+2 






0235 


TRA 


2,1 


YES 




0236 


TRA 


1,1 


NO 




0237 


• CONSTANTS, 


TEMPORARIES 






0238 


AMASK OCT 


777777700000 






0239 


TSXZ TSX 


0,0 






0240 


TRABAK TRA 


BACK 






0241 


TSXZ4 TSX 


0,4 






0242 


STOP OCT 


777777712345 






0243 


SAVNXT PZE 


♦ * # ** f #• 


TEMP 


FOR INSTRUCTION 


0244 


ZIFCA1 PZE 


• *,0 


»* - 


0 IF CASE 1, NOT^O IF CASE 2 


0245 


END 








0246 
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• PLYSYN (SUBROUTINE) 10/5/64 LAST CARD IN DECK IS NO. 0161 

* LABEL 0001 
CPLYSYN 0002 

SUBROUTINE PLYSYNt SCALES, RAOI I , DGREES, NROOTS, PL YC0S#NC0FS| SPACE ) 0003 

C 0004 

C ABSTRACT- 0005 

C 0006 

C TITLE - PLYSYN 0007 

C POLYNOMIAL SYNTHESIZED FROM ITS REAL AND COMPLEX ROOTS 0008 

C 0009 

C GIVEN REAL ROOTS XU) WITH REAL SCALE FACTORS UIII WHERE 0010 

C I RUNS FROM 1 TO M AND GIVEN COMPLEX ROOTS Y(J) WITH REAL 0011 

C SCALE FACTORS V<J) WHERE J RUNS FROM 1 TO N# SUBROUTINE 0012 

C POLYSYN COMPUTES THE REAL POLYNOMIAL COEFFICIENTS 0013 

C A*OJ ,A(1),...,A(N+2M) 0014 

C ACCORDING TO THE FORMULA 0015 

C 0016 

C AIO> + A(1)Z ♦ A<2)Z»»2 + ... ♦ ACM+2N )Z**<M*2N3 * 0017 

C 0018 

C M N 0019 

C PRODUCT UUMZ-XU)) PRODUCT V( J) (Z—Y< J) ) IZ— Y(J)BAR) 0020 

C 1*1 J * 1 0021 

C 0022 

C WHERE Yt J) BAR IS THE COMPLEX CONJUGATE OF YCJ). 0023 

C 0024 

C NOTE - N OR M MAY BE ZERO BUT NOT BOTH. 0025 

C 0026 

C LANGUAGE - FORTRAN II SUBROUTINE 0027 

C EQUIPMENT - 709 OR 7090 f MAIN FRAME ONLY) 0028 

C STORAGE - 172 REGISTERS 0029 

C SPEED - 0030 

C AUTHOR - E.A. ROBINSON 0031 

C 0032 

C —-USAGE — «~< 0033 

C 0034 

C TRANSFER VECTOR CONTAINS ROUTINES - CONVLV 0035 

C AND FORTRAN SYSTEM ROUTINES - COS 0036 

C 0037 

C FORTRAN USAGE 0038 

C CALL PLYSYNi SCALES, RADI I, DGREES, NROOTS, PL YC0S,NC0FS^SPAC£) 0039 

C 0040 

C INPUTS 0041 

C 0042 

C SCALESU) 1*1. ..NROOTS IS THE NUMERICAL VALUE OF EACH OW THE SCALE 0043 

C FACTORS UU), VCJ) LISTED IN ANY ORDER 0044 

C 0045 

C RADI III) 1*1. ..NROOTS IS THE ABSOLUTE VALUE OR THE NEGATIVE OF 0046 

C THE ABSOLUTE VALUE OF EACH OF THE ROOTS X(I), Y<J) 0047 

C LISTED IN THE SAME ORDER AS SCALES! I) 0048 

C 0049 

C OGREESCI) 1=1... NROOTS IS THE ANGLE IN DEGREES OF EACH OF THE 0050 

C ROOTS, LISTED IN THE SAME ORDER. THE ANGLE IS 0051 

C DETERMINED BY THE EQUATION 0052 

C 0053 

C ROOT * RADII » EXP(SQUARER00Tf-l)«ANGLE«Pi/180) 0054 

C 0055 

C FOR REAL ROOTS, THE ANGLES WILL BE ZERO OR MULTIPLES 0056 

C OF 180. PLYSYN CONSIDERS THE ROOT TO BE REAL ONLY IF THE 0057 

C ANGLE IS EXACTLY ZERO OR AN EXACT MULTIPLE OF 180. 0058 

C 0059 

C NROOTS INTEGER EQUAL TO M+N 0060 

C MUST EXCEED ZERO 0061 

C 0062 

C 0063 

C OUTPUTS 0064 

C 0065 

C PLYCOSII) 1=1.*. NCOFS IS THE POLYNOMIAL COEFFICIENTS, WHERE AIO) 0066 

C IS PLYCOSII), Ail) IS PLYC0SC2), 0067 

C A(M*2N) IS PLYCOS(NCOFS) 0068 

C 0069 

C NCOFS IS THE NUMBER OF POLYCOEFFICIENTS, WHICH IS * TO M+2N+1 0070 

C 0071 

C SPACEU) 1*1.. .NCOFS MUST BE AVAILABLE FOR TEMPORARY STORAGE 0072 

C 0073 
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C EXAMPLES 0074 

C 0075 

C I. CASE OF ONE REAL ROOT OUTSIDE UNIT CIRCLE 0076 

C INPUTS - SCALESll) * 1.0 RADII(l) « 1.25 DGREESOl) * 720-* 0077 

C NR0OTS = 1 0078 

C OUTPUTS - PLYC0SU...2) » -1.25, 1.0 NCOFS =2 0079 

C 0080 

C 2. CASE OF ONE REAL ROOT INSIDE UNIT CIRCLE WHICH IS RECIPROCAL 0081 

C TO ROOT ABOVE 0082 

C INPUTS - SCALESll) » -1.25 RAOII(l) =t .8 DGREEStl) * -720* 0083 

C NROOTS =1 0084 

C OUTPUTS - PLYC0SU...2) = 1.0,-1.25 NCOFS * 2 0085 
C (NOTE - THIS PLYCOS IS THE REVERSE OF THE PLYCOS A8DVEI 0086 

C 0087 

C 3. CASE OF ONE COMPLEX ROOT OUTSIDE THE UNIT CIRCLE 0088 

C INPUTS - SCALESll) » 1.0 RADI 1(1) « 1.25 DGREESU) » 45. 0089 

C NROOTS * 1 0090 

C OUTPUTS - PLYC0S11...3) = 1.5625, -1.767767, 1.0 NCOFS * 3 0091 

C 0092 
C 4. CASE OF ONE COMPLEX ROOT INSIDE THE UNIT CIRCLE WHICH IS RECIPROCAL 0093 

C OF ROOT ABOVE 0094 

C INPUTS - SCALES(l) * 1.5625 RADII(l) = .8 DGREES(l) - -45* 0095 

C NROOTS « 1 0096 

C OUTPUTS - PLYCCSU...3) = 1.0, -1.7677669, 1.5625 NCOFS * 3 0097 
C (NOTE - THIS PLYCOS IS THE REVERSE OF THE PLYCOS ABOVE) 0098 

C 0099 

C 5. CASE OF TWO REAL AND ONE COMPLEX ROOTS OUTSIDE THE UNIT CIRCLE 0100 
C INPUTS - SCALESll. ..3) = l.,l.,l. RADIK1...3) * 1.25,1.25,-1.25 0101 

C DGREES(1..*3) * 0., 90. ,720. NROOTS * 3 0102 

C OUTPUTS - PLYCOSl 1. • .5 ) = -2. 4414, 0. , 0. , 0. , 1. NCOFS = 5 0103 

C 0104 

C 6. CASE OF TWO REAL AND ONE COMPLEX ROOTS INSIDE THE UNIT CIRCLE 0105 

C WHICH ARE RECIPROCALS OF ROOTS ABOVE 0106 

C INPUTS - SCALES ( 1 ... 3 ) » -1.25, 1.5625,1.25 RADI I ( 1*..3> * -.8, 0107 

C -.8, .8 DGREESt 1...3) = -540* ,-270. ,-180. NROOTS * 3 0108 

C OUTPUTS - PLYC0SU...5) = 1. , 0. , 0.,0.,-2.4414 0109 
C INOTE - THIS PLYCOS IS THE REVERSE OF THE PLYCOS ABOVE* 0110 

C 0111 

C 7. CASE OF AUTOCORRELATION POLYNOMIAL 0112 

C INPUTS - SCALESll, 2) * l.,1.5625, RADII(1,2) * 1.25, -.8 0113 

C DGREESU, 2) = 90. ,270. NR00TS=2 0114 

C OUTPUTS - PLYCOSl I. • .5) = 1.5625, 0., 3.4414,0. ,1. 5625 NCOFS & 5 0115 

C 0116 

C 8. CASE OF ANOTHER AUTOCORRELATION POLYNOMIAL 0117 

C INPUTS - SCALESll...4)=l.,4.,l.,16. RADI I ( 1 . . . 4 ) =2 . , . 5 , 4. , . 25 0118 

C DGREES (1..*4)=32.,-32.,199.,199. 0119 

C OUTPUTS - PLYC0Sll...9)*64. ,242. ,-468. .-1420., 4723. 142Q. «-468. , 0120 

C 242. ,64. NCOFS *9 0121 

C (THE VALUES OF PLYCOS GIVEN HERE ARE TRUNCATED TO WHOLE 0122 

C NUMBERS.) 0123 

C 0124 

DIMENSION SCALES (2) , RAD 1 1 1 2 ) , DGREESl 2 ) , PLYCOSl 2) , SPACE( 2 HTl 3) 0125 

C CHECK FOR ILLEGAL NROOTS BEFORE ENTERING LOOP 0126 

IF (NROOTS) 9999,9999,10 0127 

10 DO 200 1-1, NROOTS 0128 

SCALE » SCALES(I) 0129 

RADIUS » RADI I ( I ) 0130 

15 ANGLE a? MODF(DGREES( I), 360.) 0131 

IF ( ABSF ( ANGLE )-180. ) 20,50,20 0132 

C ANGLE NOT = 180 IN MAGNITUDE 0133 

20 IF (ANGLE) 100,60,100 0134 

C ANGLE DOES * 180 0135 

50 RADIUS = -RADIIU) 0136 

C SET UP T(l) T(2) FOR CASE ANGLE = 180 OR ZERO 0137 

60 Til) = -RADIUS*SCALE 0138 

T(2) « SCALE 0139 

NT - 2 0140 

GO TO 150 0141 

C COMPLEX ROOTS CASE 0142 

100 NT = 3 0143 

T(l) = SCALE»RADIUS»RADIUS 0144 

T(2) * -2. *RADIUS»C0SF(ANGLE*3. 14159265/180. )»SCALE 0145 

T(3) = SCALE 0146 

C CHECK FOR FIRST ROOT 0147 

150 IF (1-1) 180,160,180 0148 
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C IF FIRST ROOT MOVE T(I) INTO PLYCOSU) AND NT INTO NCOFS 0149 

160 NCOFS = NT 0150 

DO 170 J=1,NT 0151 

170 PLYCOSU) = TU1 0152 

GO TO 200 0153 

C CONVOLVE IF NOT FIRST ROOT AND RESET NCOFS AND PLYCOSC l> 0154 

180 CALL CONVLVCNCOFS, PLYCOS, NT, T, SPACE) 0155 

NCOFS = NCOFS+NT-1 0156 

DO 190 J=1#NC0FS 0157 

190 PLYCOSU) « SPAGE(J) 0158 

200 CONTINUE 0159 

9999 RETURN 0160 

END 0161 
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* POKCTl ISUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO, 0133 

• LABEL 0001 
CP0KCT1 0002 

SUBROUTINE POKCTl (IX, NHANDS, ICT, I ANS I 0003 

C 0004 

C ——ABSTRACT 0005 

C 0006 

C TITLE - POKCTl 0007 
C EVALUATION OF INTEGER SEQUENCE IN GROUPS OF FIVE AS POKER HANDS. 0008 

C 0009 

C POKCTl BREAKS UP A FORTRAN II INTEGER SEQUENCE INTO NON- 0010 

C OVERLAPPING GROUPS OF FIVE DIGITS WHICH IT TREATS AS POKER 0011 

C HANDS. THE HANDS ARE EVALUATED AND A TABULATION OF THE 0012 

C NUMBER OF DIFFERENT TYPES OF HANDS IS PRODUCED. THE A 0013 

C PRIORI PROBABILITIES OF DIFFERENT HAND TYPES ARE KNOWN FOR 0014 

C THE CASE OF INDEPENDENT EQUALLY LIKELY DIGITS FROM ZERO TO 0015 

C NINE. HENCE A POKER COUNT IS USEFUL IN DETERMINING THE 0016 

C INDEPENDENCE OF A SEQUENCE. THE A PRIORI PROBABILITIES, 0017 

C DUE TO DAVID DURAND OF M.I.T., ARE GIVEN BELOW AND ARE 0018 

C EXACT. THE DECIMALS TERMINATE AT THE FOURTH PLACE. 0019 

C , 0020 

C BUST .2952 0021 

C 1 PAIR .5040 0022 

C 2 PAIR .1080 0023 

C 3 OF A KIND .0720 0024 

C FULL HOUSE .0090 0025 

C STRAIGHT .0072 0026 

C 4 OF A KIND .0045 0027 

C 5 OF A KIND .0001 0028 

C 0029 

C LANGUAGE - FORTRAN II SUBROUTINE 0030 

C EQUIPMENT - 709 OR 7090 { MAIN FRAME ONLY) 0031 

C STORAGE - 219 REGISTERS 0032 

C SPEED - 0033 

C AUTHOR - S.M. SIMPSON 0034 

C 0035 

C —USAGE 0036 

C 0037 

C TRANSFER VECTOR CONTAINS ROUTINES - FRQCTl 0038 

C AND FORTRAN SYSTEM ROUTINES - NONE 0039 

C 0040 

C FORTRAN USAGE 0041 

C CALL P0KCT1HX, NHANDS, ICT, IANS) 0042 

C 0043 

C INPUTS 0044 

C 0045 

C IXU) I=l...5«NHANDS IS THE DIGIT SEQUENCE 0046 

C ZERO LESS THAN OR = IX LESS THAN OR * 9 0047 

C 0048 

C NHANDS IS THE NUMBER OF HANDS TO BE FORMED FROM THE IX SEQUENCE. 0049 

C NHANDS MUST BE GREATER THAN ZERO. 0050 

C 0051 

C OUTPUTS 0052 

C 0053 

C ICTU) 1 = 1.. .8 IS THE COUNT OF TYPES OF HANDS FOUND WHERE 0054 

C ICT(l) * NO. OF HANDS OF NO VALUE 0055 

C ICT(2) » NO. OF HANDS WITH 1 PAIR 0056 

C ICT <3 ) = NO. OF HANDS WITH 2 PAIRS 0057 

C ICT(4) = NO. OF HANDS WITH 3 OF A KIND 0058 

C ICT<5) * NO. OF STRAIGHTS 0059 

C ICT16) = NO. OF FULL HOUSES 0060 

C ICT(7) * NO. OF HANDS WITH 4 OF A KIND 0061 

C ICT(8) a NO. OF HANDS WITH 5 OF A KIND 0062 

C WHERE HAND NO. 1 =( IXC 1 ) , IX( 2) , IXf 3) , IX* 4) , IXC 5)) 0063 

C HAND NO. 2 IX<6)»IXI7), IX(8)*IXi9), IXUO)) 0064 

C ETC. 0065 

C AND SUM OF ICTU) = NHANDS. 0066 

C 0067 

C IANS «0 NORMAL 0068 

C =1 ILLEGAL NHANDS 0069 

C =3 ERROR RETURN FROM FRQCTl 0070 

C 0071 

C EXAMPLES 0072 

C 0073 

C I. INPUTS - NHANDS = 0 0074 
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IX(I) 1 = 1,280 



c 


(BROKEN INTO GROUPS OF FIVE FOR 


EASY CHECK ING1 


c 


40123 


43125 


23456 


52643 


76543 


87654 


95867 


c 


97654 


02345 


98762 


14327 


02678 


86430 


63142 


c 


01230 


18741 


32024 


99413 


08628 


54531 


07499 


c 


01220 


42246 


45999 


94977 


82238 


77335 


55060 


c 


10020 


23334 


06033 


88381 


74877 


06006 


15113 


c 


11222 


21212 


80808 


94449 


55454 


61116 


06006 


c 


90000 


66866 


44644 


88883 


21111 


00700 


0999f 


c 


99999 


00000 


Hill 


22222 


66666 


33333 


36410 


c 


OUTPUTS - ICTU. 


..8) = 


0,0*0,0 


,0,0,0, 


0 IANS=1 





INPUTS 
OUTPUTS 



SAME AS EXAMPLE 1. EXCEPT NHANDS=56 
ICT(1.*.8) = 8,7,7,6,7*8,7,6 IANS=0 



10 



DIMENSION IX(2*,ICT(2), IC1 ( 10 ) , IC2 ( 6 ) 
CLEAR THE OUTPUT VECTOR. THEN WORK THRU DATA HAND BY HAND. 
IANS=1 

IF ( NHANDSI 9999,9999,10 
IANS=0 
DO 15 1=1,8 
15 ICT(I)=0 

DO 90 II«1,NHANDS 

C FOR EACH HAND FIRST MAKE A FREQUENCY COUNT OF THE DIGITS (VALUES 0-91. 
C NOTE RESTRICTION 1 VIOLATION IS CAUGHT BY FRQCT1. 
J*UI-1)*5+1 

CALL FRQCTHIXt J), 5,0,9, IC1, IANS) 
IF(IANS) 9991,21,9991 
C AND THEN MAKE A FREQUENCY COUNT OF THE FREQUENCY COUNT (VALUES 0 TO 5# 

21 CALL FRQCT1(IC1#10,0,5,IC2,IANS) 
IF( IANS) 9991,22,9991 

C THE HAND VALUE, IVAL (1 TO 8), IS DETERMINABLE FROM IC2C1) t 1C2( 3! • 
C IC2(2) EXCEPT FOR STRAIGHTS. 

22 IVAL=1 

IF (IC2U)-6) 60,92,50 
50 IF (IC2(3)-1> 55,96,93 
55 IF (IC2(2)-1) 98,97,94 
C CHECK FOR POSSIBLE STRAIGHT WHEN ALL DIGITS ARE DIFFERENT. 
60 1*0 
62 1=1+1 

IF (ICKI)) 70,62,70 

70 IF (ICUI + D) 71,91,71 

71 IF (IC1U+2)) 72,91,72 

72 IF (ICKI+3)) 73,91,73 

73 IF (ICHI+4)) 95,91,95 
C SET THE HAND VALUE. 

98 IVAL=IVAL+l 

97 IVAL=IVAL+1 

96 IVAL=IVAL+1 

95 IVAL=IVAL+1 

94 IVAL=IVAL+1 

93 IVAL=IVAL+1 

92 IVAL=IVAL+l 

91 ICT(IVAL)=ICT(IVAL)+1 

90 CONTINUE 
9999 RETURN 
9991 IANS=3 

GO TO 9999 
END 
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0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0tl7 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
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» POLYDV (SUBROUTINE) 

» LABEL 
CPOLYDV 

SUBROUTINE POLYDV i N,DVS,M,DVD, L, Q ) 

C 

c 
c 
c 

C TITLE - POLYDV 



9/9/64 LAST CARD IN DECK IS NO. 



——ABSTRACT 



C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

C LANGUAGE 



PERFORM LONG DIVISION OF TWO POLYNOMIALS 



POLYDV COMPUTES THE FIRST L COEFFICIENTS OF THE QUOTIENT 



OF TWO POLYNOMIALS. 
THEIR COEFFICIENTS. 



THE POLYNOMIALS ARE SPECIFIED BY 
SOME OF THE LAST COEFFICIENTS MAY 
TURN OUT TO BE ZERO IF THE QUOTIENT IS AN EXACT 
POLYNOMIAL OF ORDER LESS THAN L. THE REMAINDER IS NOT 
COMPUTED. THE COMPUTATION IS 

2 3 (L-l) 

QUMQ(2)»X+Q(3)*X +Q(4)*X +...+Q(L)*X ^REMAINDER 



(M+l) 

=DVD(1)+DVD(2)»X+..»DVD(M)*X /DVS( 1 ) *• 



N-l 



•OVS€N)«X 



WHERE X IS UNSPECIFIED SINCE ALL OPERATIONS ARE ON THE 
COEFFICIENTS, 
Q IS THE QUOTIENT VECTOR, 
OVD IS THE DIVIDEND VECTOR, 
DVS IS THE DIVISOR VECTOR. 

- FORTRAN- I I SUBROUTINE 



C EQUIPMENT - 709, 7090, 7094 (MAIN FRAME ONLY) 



*# ji ui\muu 

C SPEED 

C 

C 

C AUTHORS 
C 



- TAKES ABOUT .0006»L*MINIMUM( L, N) SECONDS ON THE 
7094 MOD 1. (ESTIMATE IS CONSERVATIVE - IN SOME 
CASES IF MAY BE 50 PERCENT HIGH.) 

- J. CLAERBOUT AND R.A. WIGGINS 



C 

C USAGE 

C 

C TRANSFER VECTOR CONTAINS ROUTINES - MOVE, STZ 



AND FORTRAN SYSTEM ROUTINES 



C 
C 

C FORTRAN USAGE 

C CALL POLYDVCN,DVS,M,DVD,L,Q) 

C 

C 

C INPUTS 
C 

C N 
C 
C 

C DVS(I) 
C 
C 

C M 
C 
C 

C DVD(I) 
C 

C L 
C 
C 
C 

C OUTPUTS 
C 

Q(I) 



(NOT ANY) 



NUMBER OF COEFFICIENTS IN DIVISOR POLYNOMIAL 
MUST BE GRTHN= 1 . 

1=1,... ,N COEFFICIENTS OF DIVISOR POLYNOMIAL 
DVS(l) MUST BE NON ZERO 

NUMBER OF COEFFICIENTS IN DIVIDEND POLYNOMIAL 
MUST BE GRTHN= 1 . 

1=1,... #M COEFFICIENTS OF DIVIDEND POLYNOMIAL 

NUMBER OF COEFFICIENTS IN QUOTIENT POLYNOMIAL 
MUST BE GRTHN= I . 



C 
C 
C 
C 

C EXAMPLES 
C 

C 1. INPUTS 



1=1,... ,L COEFFICIENTS IN QUOTIENT POLYNOMIAL 
EQUIVALENCE ( Q, DVD ) ALLOWED. 



N=2 



DVD(l)=l. 

DVS( 1...2)=l.,-.5 



0101 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 

0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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C L=4 0075 

C OUTPUTS - Q(i... 4)*1. ,.5, .25, .125 0076 

C 0077 

C 2* INPUTS - M=3 , BVD(1...3)= l.,2.,l. 0078 

C N*2 , 0VS(1.*.2)= l.tl. 0079 

C L=10 0080 

C OUTPUTS - Q{ 1...10)=1.,1. , 0.,0.,0.,0.,0.t0.,0*»0. 0081 

C 0082 

C PROGRAM FOLLOWS BELOW 0083 

C 0084 

DIMENSION DVSf2),DVD(2),Q<2) 0085 

MI NML-XMI NOF ( M » L ) 0086 

CALL MOVE { MI NML , DVD, 0 ) 0087 

CALL STZ i L-MINML»Q(MINML+1 ) ) 0088 

MM1=N-1 0089 

DO 50 1=1, L 0090 

Qin*Q(I)/DVS(l) 0091 

LSUB^XMINOF <NM1,L-I) 0092 

IF (LSUB) 50,50*10 0093 

10 CONTINUE 0094 

K=I 0095 

DO 20 J*l,LSUB 0096 

K=K+1 0097 

20 QIK)*Q(K)-Q{ I)*DVS( J + l) 0098 

50 CONTINUE 0099 

RETURN 0100 

END 0101 
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• POLYEV SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0061 

* LABEL OOOi 
CPOLYEV 0002 

SUBROUTINE POLYEV! N,C f X, A) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - POLYEV 0007 

C EVALUATE A POLYNOMIAL WITH REAL COEFFICIENTS FOR REAL ARGUMENT 0008 

C 0009 

C POLYEV EVALUATES A POLYNOMIAL. THAT IS f GIVEN THE 0010 

C POLYNOMIAL COEFFICIENTS CU...N), POLYEV FINDS THE VALUE* 0011 

C A, OF THE POLYNOMIAL FOR A GIVEN X, tC AND X REALI 0012 

C 0013 

C 2 3 N-l 0014 

C A = C< 1)+C<2)*X+C<3)»X +C(4)»X +*i.+X<NJ»X 0015 

C 0016 

C SPEED IS GAINED BY GROUPING THE POLYNOMIAL AS <*0R N*51 0017 

C 0018 

C A = C(1)+X*<C{2)*X*<C<3)+X»<C<4)+X»CI5)*>) 0019 

C 0020 

C LANGUAGE - FORTRAN II SUBROUTINE 0021 

C EQUIPMENT - 709 OR 7C90 (MAIN FRAME ONLY) 0022 

C STORAGE - 54 REGISTERS 0023 

C SPEED - ABOUT 35 TIMES NUMBER OF COEFFICIENTS MACHINE SYCLES i 0024 

C AUTHOR - J.F. CLAERBOUT 0025 

C 0026 

C — — USAGE 0027 

C 0028 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0029 

C AND FORTRAN SYSTEM ROUTINES - NONE 0030 

C 0031 

C FORTRAN USAGE GG3Z 

C CALL POLYEV( N«C#Xt A) 0033 

C 0034 

C INPUTS 0035 

C 0036 

C C(I) I-lf..«UN ARE THE COEFFICIENTS OF THE POLYNOMIAL^ 0037 

C IS FLOATING POINT. 0038 

C 0039 

C N IS FORTRAN INTEGER 0040 

C MUST BE GRTHN-1. 0041 

C 0042 
C X IS THE VALUE FOR WHICH THE POLYNOMIAL IS TO BE EVALUATEO* 0043 

C MUST BE FLOATING POINT. 0044 

C 0045 

C OUTPUTS 0046 

C 0047 

C A IS THE VALUE OF THE POLYNOMIAL. 0048 

C 0049 

C EXAMPLES 0050 

C 0051 

C 1. INPUTS - N * 3 CU...3) = I. ,2. ,3. X=2. 0052 

C OUTPUTS - A 17. 0053 

C 0054 

DIMENSION C(IOO) 0055 

A=0. 0056 

DO 10 I=1»N 0057 

J=N-I 0058 

10 A=X*A+CJJ+1) 0059 

RETURN 0060 

END 0061 
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* POLYSN » 
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» POLYSN { SUBROUTINE ) 9/8/64 LAST CARD IN DECK IS NO* 

» LABEL 

IPOLYSN 

SUBROUTINE POLYSN (SCALE, NOZ,ZRE, Z IM, Z I FCOM, ZIFCNJ, tsPOLV*POLY, 
1 SPACE) 



ABSTRACT 

TITLE - POLYSN 

POLYNOMIAL SYSTHESIS FROM REAL AND COMPLEX ROOTS 

SUBROUTINE POLYSN SYNTHESIZES A POLYNOMIAL WITH REAL 
COEFFICIENTS FROM REAL AND COMPLEX ROOTS* NECESSARILY, 
THE COMPLEX ROOTS OCCUR IN COMPLEX CONJUGATE PAIRS* 
POLYSN ALLOWS OPTIONS FOR THE USER TO SPECIFY ilTHER ONE* 
OR BOTH, OF THE ROOTS IN THESE PAIRS* ALSO, THE COMPLEX 
ROOTS MAY BE SPECIFIED BY THEIR REAL AND IMAGINARY PARTS, 
OR BY THEIR MAGNITUDE AND ARGUMENT (IN DEGREES)*. 



LANGUAGE 
EQUIPMENT 
STORAGE 
SPEED 

AUTHOR 



FORTRAN II SUBROUTINE 

709, 7090, 7094 (MAIN FRAME ONLY) 

256 RL ISTERS 

TAKES ABOUT .0010 ♦ .0001l*N»N SECONDS ON THE 
7094 MOD 1, WHERE N IS THE NUMBER OF ROOTS* 
R. A. WIGGINS 4/64 



USAGE 

TRANSFER VECTOR CONTAINS ROUTINES - CONVLV, MOVE 
AND FORTRAN SYSTEM ROUTINES - COS, SQRT 

FORTRAN USAGE 

CALL POLYSNC SCALE, NOZ, ZRE, Z I M,ZlFC0M t ZIFCN J, LPOLY, POLY, SPACE! 



INPUTS 
SCALE 

NOZ 
ZREU) 

ZIM(I) 



IS A SCALE VALUE THAT POLYNOMIAL IS MULTIPLIED BYi 
IF - 0* , THE POLYNOMIAL IS SCALED SO THAT P0LYUM1. 

NUMBER OF ZEROES GIVEN. 

1=1.. .NOZ GIVES THE REAL PART IF ZIFCOM * 0., SIVES THE 
MAGNITUDE IF ZIFCOM NOT * 0. 

1=1.. .NOZ GIVES THE IMAGINARY PART OF THE ZERO IF 
ZIFCOM = 0., GIVES THE ARGUMENT (IN DEGREES) IF 
ZIFCOM NOT = 0. 



ZIFCOM = 0. IF ZEROES SPECIFIED BY REAL AND IMAGINARY PARTS. 

NOT= 0. IF ZEROES SPECIFIED BY MAGNITUDE AND ARGUMENT. 

ZIFCNJ » 0. IF POLYSN MUST FIND THE CONJUGATE OF ALL NON-REAL 
ROOTS. I.E. ONLY ONE OF EACH PAIR OF CSMPLEX 
CONJUGATES IS SPECIFIED IN ZRE AND ZIM. 
NOT= 0. IF CONJUGATE OF EACH NON-REAL ROOT IS ACTUALLY 
CONTAINED IN ZRE AND ZIM. POLYSN ASSUMES THAT 
THESE CONJUGATE PAIRS ARE STORED SEQUENTIALLY* 

SPACE(I) I=1...2*N0Z IS TEMPORARY COMPUTATION SPACE- 



OUTPUTS 
LPOLY 
POLY(I) 



LENGTH OF POLYNOMIAL FORMED. 



1=1... LPOLY CONTAINS THE COEFFICIENTS OF THE POLYNOMIAL 
IN ORDER OF INCREASING POWERS OF Z. 



EXAMPLES 

1. INPUTS - SCALE = 1. NOZ = 1 ZREU) = -.5 ZIMC1) * 0. ZIFCOM=0. 



0166 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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C ZIFCNJ = 0. 0075 

C OUTPUTS - LPOLY * 2 P0LYU...2) » .333, .667 0076 

C 0077 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT SCALE = 0. 0078 

C OUTPUTS - LPOLY » 2 P0LYU...2) « i.,2. 0079 

C 0080 

C 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT ZIM(l) » 180. ZIFCOM * 1. 0081 

C OUTPUTS - LPOLY » 2 P0LY(1...2) * -*333,.667 0082 

C 0083 

C 4. INPUTS - SAME AS EXAMPLE 1. EXCEPT ZREtl) » .5 ZIM(l) * ^5 0084 

C OUTPUTS - LPOLY * 3 P0LYU...3) « . 172,-. 343, . 343 0085 

C 0086 

C 5. INPUTS - SAME AS EXAMPLE 1. EXCEPT ZIM(U * 45. ZIFCOM * 1. 0087 

C OUTPUTS - LPH5LY * 3 P0LYU...3) * . Ill, -.314, .444 0088 

C 0089 

C 6. INPUTS - SCALE * 1. NOZ » 2 ZIFCOM * 0. ZIFCNJ = 0. 0090 

C ZREU...2) = .5,2. ZIM(1...2) * 0.,1. 0091 

C OUTPUTS - LPOLY * 4 P0LY(1...4) =? 159, . 446,-. 286, ^0637 0092 

C 0093 

C 7. INPUTS - SCALE * 1. NOZ = 3 ZIFCOM * 0. ZIFCNJ = 1. 0094 

C ZREd.4.3) * .5,2. ,2. ZIMCU..3) * 0.,1.,-1. 0095 

C OUTPUTS - LPOLY * 4 P0LY(1...4) * 159, . 446,-. 286, .0637 0096 

C 0097 

C 0098 

C PROGRAM FOLLOWS BELOW 0099 

C 0100 

DIMENSION ZREC2J,ZIM(2),PGLY(2),SPACE(2) 0101 

DIMENSION T(i3) 0102 

IF ( NOZ) 999,999,10 0103 

10 CONTINUE 0104 

C0NV=3. 14159265/180. 0105 

LPLY =1 0106 

KULY 111=1. G1G7 

IFST=0 0108 

DO 120 1*1, NOZ 0109 

ZR=ZRE(I) 0110 

ZI=ZIM(I) 0111 

IF (ZIFCNJ) 12,18,12 0112 

12 CONTINUE 0113 

IF (IFST) 18,18*14 0114 

14 CONTINUE 0115 

IFST=*0 0116 

GO TO 120 0117 

18 CONTINUE 0118 

IF (ZIFCOM) 50,20,50 0119 

C ZEROES ARE EXPRESSED BY THEIR REAL AND IMAGINARY PARTS 0120 

20 CONTINUE 0121 

IF (ZI) 40,30,40 0122 

C SINGLE ZERO 0123 

30 CONTINUE 0124 

T(2)=1./(1.*ABSF(ZR) ) 0125 

T(l)=-ZR»T(2) 0126 

NT-2 0127 

GO TO 100 0128 

C DOUBLE ZERO 0129 

40 CONTINUE 0130 

TUWR»ZR+ZI*ZI 0131 

T(3) = 1./U1. + SQRTF(T(1) ) )*( l.+SQRTF I T i 1) ) J ) 0132 

TU)=T(1)»T13) 0133 

T(2)=-2.»ZR*T!3) 0134 

IFST=1 0135 

NT=3 0136 

GO TO 100 0137 

C ZEROES ARE EXPRESSEO BY MAGNITUDE AND PHASE 0138 

50 CONTINUE 0139 

ZI «M0DF(ZI,360.) 0140 

IF (ABSF(ZI)-180.) 70,60,70 0141 

60 ZR*-ZR 0142 

GO TO 30 0143 

70 IF (ZI) 80,30,80 0144 

C DOUBLE ZERO 0145 

80 CONTINUE 0146 

T(3) = 1./H1.+ABSF(ZR))*(1.4-ABSF(ZR) ) ) 0147 

T(1)=ZR»ZR*T(3) 0148 

T(2)=-2.»ZR«C0SF(ZI*CONV)»T(3) 0149 
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IFST=1 
NT=3 

C CONVLV AND RESET LPOLY AND PLYCOSCI) 
100 CONTINUE 

CALL CONVLV (LPLY » POLY » NT » T ? SPACE ) 

LPLY =LPLY +NT-1 

CALL MOVE (LPLY , SPACE, POLY) 
120 CONTINUE 

SC^SCALE 

IF (SO 140 f 130#140 
130 SC=1./PGLY( 1 ) 
140 CONTINUE 

DO 150 1=1, LPLY 
150 P0LY(I) = SC»P0LYU) 

LPOLY*LPLY 
999 RETURN 

END 
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0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 



**»#*»«##»»«***»*»#*##»» 

• POWER « 

• #*-»*»**«•*•*«**•»»**»#» 



PROGRAM LISTINGS 



*******«*•«*•«#***»**«** 

# POWER * 
#•**•*•*•****#»*»•*••*** 



* 


POWER 


(SUBROUTINE) 9/29/64 LAST CARD IN 


DECK 


IS NO. 0129 


• 


FAP 






0001 


•POWER 






0002 




COUNT 


150 




0003 




LBL 


POWER 




0004 




ENTRY 


POWER (X,LX,N,X2NTH) 




0005 




ENTRY 


SMPRDV (X,LX,N, XBASE, SXMB2N) 




0006 










0007 


* 




ABSTRACT — 




0008 










0009 


# 


TITLE - POWER , WITH SECONDARY ENTRY SMPRDV 




0010 




RAISE 


VECTOR TO POWER OR SUM POWER OF DEVIATIONS FROM 


BASE 


001 1 










0012 


* 




POWER RAISES ELEMENTS OF A VECTOR TO A POSITIVE 


OR 


001 3 


* 




NEGATIVE INTEGER POWER. OUTPUT MAY REPLACE INPUT. 


0014 










0015 






SMPRDV SUMS THE N-TH POWER OF THE DEVIATIONS OF 


A 


0016 






VECTOR FROM A CONSTANT, WHERE N IS POSITIVE OR 


0017 






NEGATIVE. 




001 8 


* 








0019 




LANGUAGE 


FAP SUBROUTINES, FORTRAN— 1 1 COMPATIBLE 




0020 




EQUIPMENT - 


709 OR 7090 (MAIN FRAME ONLY) 




002 1 


• 


STORAGE 


50 REGISTERS 




0022 


• 


SPEED 


7090 709 




0023 


• 




146 OR 50) + (70 TO 270)»LX MACHINE CYCLES, 




0024 


* 




DEPENDING ON ARGUMENTS 




0025 


• 


AUTHOR 


S.M.SIMPSON, SEPTEM8ER 1963 




0026 


* 








0027 


* 




t USAGE >- 




0028 


• 








0029 


* 


TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 




0030 


* 


AND FORTRAN SYSTEM ROUTINES - EXP(2 




0031 










nnao 


* 


FORTRAN USAGE 




0033 


* 


CALL POWER (X, LX,N, X2NTH) 




0034 


* 


CALL SMPRDV(X, LX,N, XBASE, SXMB2N) 




0035 


* 








0036 


• 


INPUTS 






0037 










0038 




X(I) 


1 = 1.. .LX IS A FLTG PT VECTOR 




0039 


* 








0040 




LX 


MUST EXCEED ZERO. 




004 1 










0042 




N 


IS THE DESIRED POWER ( POS OR NEG OR ZERO ) 




0043 










0044 


* 


XBASE 


IS THE BASE (FOR SMPRDV) 




0045 










0046 




OUTPUTS 


STRAIGHT RETURN WITH NO OUTPUT IF LX LSTHN 1, EXCEPT 


0047 






THAT SXMB2N W T LL BE SET = 0. 




0048 










0049 




X2NTHU) 


1 = 1. ..LX IS X2NTHU) = <X(I))*#N 




0050 


* 








0051 






EQU I VALENCE( X2NTH, X ) IS PERMITTED 




0052 










0053 




SXMB2N 


IS = SUM(FROM 1=1 TO LX) CF ( X( I 3-XBASE ) *«N 




0054 










0055 




EXAMPLES 






0056 










0057 




1. INPUTS - 


XU...4) = 1., 2., 3., -4. XN4 =* -999. 


0058 




USAGE 


CALL POWER (X, 4, 3, XN1) 




0059 






CALL POWER (X, 4, -2, XN2) 




0060 






CALL POWER (X, 1, 3, XN3) 




006 1 


• 




CALL SMPRDV(X, 4, 3, 1., SXN1) 




0062 


* 




CALL POWER (X, 4, 3, X) 




0063 


• 




CALL POWER (X, 0, 3, XN4) 




0064 


• 


OUTPUTS - 


XNK1...4) = I., 8., 27., -64. 




0065 


* 




XN2U...4) = 1., .25, .1111111, .0625, 




0066 


» 




XN3 = 1. 




0067 


• 




SXN1 - -116. 




0068 


* 




X(i...4) = 1., 8., 27., -64. 




0069 


• 




XN4 = -999. (NO OUTPUT CASE) 




0070 


• 








0071 


• 


PROGRAM FOLLOWS BELOW 




0072 


» 








0073 


• 








0074 
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• TRANSFER VECTOR CONTAINS EXP<2 0075 





HTR 


o 


XR1 


0076 




HTR 


o 


XR4 


0077 




BCI 


J. , rUntn 




0078 


» PRINCIPAL 


PMTQV ' DflUCD f Y . 


1 Y - M - Y 5MTH \ 


0079 


POWER 


CLA 


/.A 




0080 




ADD 


\C 1 
IV L 




nn« i 

UUO 1 




STA 


STO 




0082 




STZ 


DAic 


ri CAD DACC 
UI_CAI% DAoc 


0083 




STZ 


Llr run 


A Kin pmtdv TwnirATno 

AnIU CnllrsT lINUlLAIUrs 


uuO'i 




CLA 


TD A D 
1 RAr 




nnpc 
UUO 3 




TRA 


CCTI ID 




uuoo 


* SECONDARY 


cntdv CMDon\/( y 
CflilKT* onf KUVi A 


1 Y _ M YRACCCYMR9N1 
, L A-jtH, ADAjtf a API D £.N 1 


UUO f 


cuoonu 
bnrKUV 


CLA* 


A. A 


X BAS E 


0088 




STO 


BASE 




UUt)7 




CLA 




A 1 QM Y WTM 1 
A 1 OrlAlNI nj 


0090 




C T A 


FAD 




009 1 






-> »*► 


ri CAD CI IM 


UU7 £ 




r i a 
LLA 


TD A C 








S XD 


/llr run 


lilrrUB nlUWtCRU J 


0094 


5E TUP 


c vn 
OAU 


Dnuco-5 - a 




0095 






rUWCR 3 , 1. 




0096 




C T A 
5 1 A 


TRA 




0097 


IV 1 


C 1 A 


1 A 
I f *» 




0098 




AUU 


Kl 


A { X ) +1 


0099 




C T A 


CLA 




0100 




CLA* 


OA 

■5 f H 


N 


0101 




crn 


POWR 




0102 




CLA* 


O A 
t f «t 


1 Y 
UA 


0103 




TUT 

I 1*51 


LEAVE 




0104 




PDX 


0-1 




0105 




T Yl 
1 AL 






0106 


» LOOP 








01 07 


CLA 


CLA 


** $ 1 


»»- A ( Y J + 1 

" » — H IA 1 ~ X. 


0108 




FSB 


BASE 




0109 




LDO 


POWR 




0110 




TSX 


$E X P { 2 # 4 




0111 


TRA 


TRA 




***jiU \Ji\ rflU 


0112 


STO 


STO 


** , l 


- - _ A f ¥9WTH\4.1 
** — A l A £ IN 1 n|ti 






TRA 


TIX 




0114 


FAD 


FAD 




- - — A f CMVMTI4I 


0115 




STO* 


FAD 




0116 


TIX 


TIX 


ri All 
LLA f Itl 




UI1 f 


* EXIT 








0118 


LEAVE 


LXD 


P0WER~2,4 




0119 




LXD 


POWER-3,1 




0120 




ZET 


ZIFPOW 




0121 




TRA 


6,4 




0122 




TRA 


5 t 4 




0123 


TRAP 


PZE 


STO 




0124 


TRAS 


PZE 


FAD 




0125 


BASE 


PZE 


♦#,**,** 


* 0.0 OR XBASE 


0126 


POWR 


PZE 


0,0,** 


= N 


0127 


ZIFPOW 


PZE 


0,0,** 


***0 IF POWER, =N0N ZERO IF S«PRD¥ 


0128 




END 






0129 
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« PRBFIT (SUBROUTINE) 9/29/64 LAST CARD IM DECK IS NO. 0186 

* LABEL 0001 

CPRBFIT 0002 
SUBROUTINE PRBF I T ( NOR, XMOM, NQUT t X, F, PH I , I ANS ) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - PRBFIT 0007 

C GENERATE PROBABILITY DISTRIBUTION WITH SPECIFIED MOMENTS 0008 

C 0009 

C PRBFIT GENERATES A ZERO-MEAN DISTRIBUTION FUNCTION* FIX)* 0010 

C WHOSE HIGHER MOMENTS t 2ND, 3RD, . • * , NTH WHERE N IS LESS 0011 

C THAN OR EQUAL 6) ASSUME GIVEN VALUES. FCX) HAS THE FORM 0012 

C OF A NORMAL DISTRIBUTION TIMES A POLYNOMIAL IN X, AND 0013 

C CONSEQUENTLY IS USEFUL FOR APPROXIMATING EMPIRICAL 0014 

C DISTRIBUTIONS WHICH ARE ROUGHLY NORMAL IN APPEARANCE, 0015 

C BUT FOR WHICH THE NORMAL APPROXIMATION IS INADEQUATE* 0016 

C IT SHOULD BE NOTED THAT THE PROCEDURE CAN YIELD NEGATIVE 0017 

C VALUES FOR THE DISTRIBUTION IN CASES WHERE THE ©EVIATION 0018 

C FROM NORMALITY IS SEVERE. 0019 

C AN ANALYSIS OF THE PROCEDURE USED MAY BE FOUND IN 0020 

C CRAMER, H., 1951, MATHEMATICAL METHODS OF STATISTICS* 0021 

C PRINCETON UNIVERSITY PRESS, PRINCETON, PAGE 222. 0022 

C 0023 

C THE FORM OF THE CALCULATION IS 0024 

C 0025 

C C(3) D D DiPHHun 0026 

C F (X) = PHUU) + » (—♦--* ) 0027 

C 1*2*3 DU DU DU 0028 

C 0029 

C C<4) D D D DIPHllU)) 0030 

C + * (--* — * — * ) ♦ . . . ♦ 0031 

C mi nu nu nu 0032 

C 0033 

C C(NOR) D D(PHKU)) 0034 

C + * i — **..* ) 0035 

C 1*2*...*N0R DU DU 0036 

C 0037 

C EVALUATED FOR A GIVEN SET OF X VALUES 0038 

C X*Xil) ,X<2) ,...,X<NOUT) 0039 

C WHERE 0040 

C D 0041 

C — DENOTES DIFFERENTIATION WITH RESP6CT TO U 0042 

C DU - 0043 

C 0044 

C U = X/SIG 0045 

C 0046 

C PHI(U) = EXP{-.5*U*U)/<SQUARE R00T<2*PI>) 0047 

C (I.E. NORMAL CURVE) 0048 

C 0049 

C PI = 3.14159265 0050 

C 0051 

C K XMOMCL) 0052 

C C1K) = SUM { - * A( K,L ) ) 0053 

C L=0 SIG 0054 

C 0055 

C A ( K,L ) = COEFFICIENT OF LTH POWER OF X IN THE KTH 0056 

C HERMITE POLYNOMIAL (X) 0057 

C 0058 

C XMOMfL) = LTH PROBABILITY MOMENT 0059 

C (INPUT PARAMETER VECTOR) 0060 

C 0061 

C SIG » SQUARE ROOTC XMOMt 2) ) 0062 

C I.E. STANDARD DEVIATION 0063 

C 0064 

C LANGUAGE - FORTRAN II SUBROUTINE 0065 

C EQUIPMENT - 709* 7090 ( MAIN FRAME ONLY) 0066 

C STORAGE - 373 REGISTERS 0067 

C SPEED - 0068 

C AUTHOR R.J. GREENFIELD, JAN 1963 0069 

C 0070 

C USAGE 0071 

C 0072 

C 0073 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0074 
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C AND FORTRAN SYSTEM ROUTINES - SQRT, EXP(2, EXP 0075 

C 0076 

C FORTRAN USAGE 0077 

C CALL PRBFIT(NOR,XMOM,NOUT,X,F, PHI, IANS) 0078 

C 0079 

C INPUTS 0080 

C 0081 

C NOR IS THE ORDER OF THE HIGHEST ORDER MOMENT GIVEN 0082 

C MUST BE GRTHN* 2 AND LSTHN * 6 0083 

C 0084 

C XMOM(I) 1*1.*. NOR CONTAINS THE MOMENTS WHICH WILL BE USED TO 0085 

C DEVELOP THE EXPANSION. THF FIRST MOMENT* XMQMIl), 0086 

C IS NOT ACTUALLY USED, BUT IS ASSUMED TO BE *0. 0087 

C U.E. ZERO MEAN ASSUMPTION). 0088 

C 0089 
C NOUT IS THE NUMBER OF X VALUES AT WHICH THE EXPANSI©N WILL B€ 0090 

C EVALUATED 0091 

C 0092 

C XU) 1*1. ..NOUT IS THE LIST OF VALUES AT WHICH THE fXPANSIGN 0093 

C WILL BE EVALUATED 0094 

C 0095 

C PHIU) USED FOR STORAGE 0096 

C MUST BE DIMENSIONED AT LEAST AS LARGE AS NOUT 0097 

C 0098 

C OUTPUTS 0099 

C 0100 

C FU) 1=1. ..NOUT ARE THE VALUES OF THE EXPANSION FOR THE 0101 

C NOUT VALUES OF X, I.E. F(I) * F<X(I)) AS DEFINED 0102 

C IN ABSTRACT 0103 

C 0104 

C IANS * 0 NORMAL 0105 

C * 1 ILLEGAL NOR 0106 

C 0107 

C 0108 

C EXAMPLES 0109 

C 0110 

C 1. (NORMAL APPROXIMATION) 0111 

C INPUTS - NO* * 2 XMUDU...4) * 0.,4.,8.,10. NOUT * 4 0112 

C XC1...4)* 0.,5.,.8,-.8 0113 

C OUTPUTS - FU...4)* . 39894, .017528, . 36828, . 36828 IANS* 0 0114 

C 0115 

C 2. INPUTS SAME AS IN EXAMPLE 1. EXCEPT NOR* 3 0116 

C OUTPUTS - FU...4)* .39894, .041265, .29854, .43800 IANS* 0 0117 

C 0118 

C 3. INPUTS - SAME AS IN EXAMPLE 1. EXCEPT NOR* 4 0119 

C OUTPUTS - FU...4)* .28051, .0333501, .22328, .36272 IANS* 0 0120 

C 0121 

C 4. INPUTS - SAME AS EXAMPLE 1. EXCEPT NOR* 0 0122 

C OUTPUTS - ERROR IANS= 1 0123 

C 0124 

C 5. INPUTS - SAME AS IN EXAMPLE 1. EXCEPT N0R*10 0125 

C OUTPUTS - ERROR IANS * I 0126 

C 0127 

DIMENSION A(7,7),C(7),PHI{100),XMOM<7),X(100),XMUD(7) 0128 

DIMENSION XMU<7),F<2) 0129 

NORDER * NOR +1 0130 

C TEST INPUT DATA 0131 

IF (NORDER-2) 31,31,32 0132 

31 IANS*i 0133 
RETURN 0134 

32 IF (NORDER-7) 33,33,31 0135 

33 IANS*0 0136 
XMUU)* I. 0137 
XMU(2)* 0. 0138 
DO 50 K*2,N0R 0139 

50 XMU(K+1)=XMGM(K) 0140 

C SET UP A TABLE 0141 

DO 1 J*l,7 0142 

I A(J,J)*1. 0143 

A{3,1)*-1. 0144 

AI4,2)*-3. 0145 

AC5,1)*3. 0146 

A(5,3)=-6. 0147 

AI6, 23*15. 0148 

A<6,4)*-10. * 0149 
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A(7,l)*-15. 
A<7,3)=45. 
A(7,5)=-15. 
C ALL SUBSCRIPTS ADVANCED BY 1 

C X(I) INPUT NORMALISED BY CALLING PROG (ZERO MEAN) 
C XMU ARE NOT NORMALIZED BUT ARE FOR ZERO MEAN 
C SEC TO COMP C 

SIG* SQRTF(XMU(3) ) 

DO 51 I=l,NOUT 
51 XII)* XUJ/SIG 

FACT*1. 

DO 5 K=l tNORDER 
C<K)=0. 

IF(K-l) 41,41,40 

40 F ACT 3C FACT*FL0ATF ( K-l ) 

41 DO 4 L=i,K 

4 C(K)=C<K)+(XMU(L)/(SIG**(L-1)))*A!K,L) 

5 Cf K)=C(K)/FACT 

C SET UP TABLE OF PHI 
DC 6 I=1,N0UT 

6 PHI ( I )-EXPF(-X( 1)*X( I)*.5)*. 3989423 
C COMPUTE F(I) FOR NORMAL DISTRIBUTION 

DO 7 I=1,N0UT 

7 FCI)=C(l)«PHI(n 
IF(N0R0ER-4) 99,8,8 

C COMPUTES OTHER ORDER F 

8 DO 19 K«4, NORDER 
DO 12 I=1,N0UT 
HER-AI K, 1) 

DO 10 L=2,K 
10 HER*HER+A(K,L)*X(I)»*tL-l) 
12 F(l)=F(I)>PHHIl*C(K)»HER 
* 9 CON T T KU IC 
99 DO 98 I=1,N0UT 
98 X (I ) = XU)«SIG 

RETURN 

END 
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0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
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* PR0B2 (SUBROUTINE) 10/6/64 LAST CARD IN DECK IS NO* 0174 

» LABEL 0001 

CPR0B2 0002 

SUBROUTINE PR0B2 ( IX, LX,N, IP,P, IXHI, iANS) 0003 

C 0004 

C — — ABSTRACT 0005 

C 0006 

C TITLE - PR0B2 0007 

C SECOND PROBABILITY DENSITY OF INTEGER SERIES AT GIVEN LAG. 0008 

C 0009 

C PR0B2 COMPUTES THE SECOND PROBABILITY DENSITY FOR AN 0010 

C INTEGER SERIES BY A FREQUENCY COUNT METHOD. THE SECOND 0011 

C PROBABILITY DENSITY , P(M,L), OF A SERIES IXIK) IS THE 0012 

C PROBABILITY THAT XIK) = M AND X(K+N)=L, WHERE N IS THE 0013 

C LAG. PR082 COMPUTES THIS QUANTITY FOR A GIVEN N. THE 0014 

C INTEGER SERIES MUST BE SCALED SUCH THAT THE LOWEST VALUE 0015 

C OF IX(K) =1 AND THE HIGHEST VALUE IS IXHI. IXHI MUST BE 0016 

C LESS THAN OR EQUAL TO THE DIMENSION OF THE PU,4) MATRIX* 0017 

C THE PROGRAM BELOW DIMENSIONS P(I,J) TO P(25#25). 0018 

C 0019 

C PR0B2 COUNTS INTO AN INTEGER MATRIX, IP(I,J), THE NUMBER 0020 

C OF TIMES IX(K)=M AND IX(K+N)=L OVER ALL INDEX PAIRS 0021 

C K, K+N SUCH THAT BOTH K AND K+N LIE IN THE INCLUSIVE 0022 

C RANGE 1 TO LX WHERE LX IS THE SERIES LENGTH^ N MAY 0023 

C BE NEGATIVE. 0024 

C 0025 

C THE INTEGER FREQUENCY COUNT MATRIX IS FLOATED INTO PfI,Jt 0026 

C AND NORMALIZED SUCH THAT SUM OVER I AND J OF P(i,J) IS li 0027 

C THIS IS DONE BY DIVIDING EACH ELEMENT BY R, WHERE 0028 

C R=LX-XABSF(N). P(I,J> AND IPU,J) MAY BE EQUIVALENT IF THE 0029 

C FREQUENCY COUNT IS NOT NEEDED. (THIS CAN BE RECONSTRUCTED 0030 

C SINCE LX AND N ARE KNOWN.) 0031 

C 0032 

C LANGUAGE - FORTRAN II SUBROUTINE 0033 

C EQUIPMENT - 709*7090 (MAIN FRAME ONLY) 0034 

C STORAGE - 229 DECIMAL REGISTERS 0035 

C SPEED - 0036 

C AUTHOR - J.N. GALBRAITH 0037 

C 0038 

C -USAGE 0039 

C 0040 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0041 

C AND FORTRAN SYSTEM ROUTINES - NONE 0042 

C 0043 

C FORTRAN USAGE 0044 

C CALL PR0B2 ( IX , LX, N, I P, P, IXH I , I ANS ) 0045 

C 0046 

C INPUTS 0047 

C 0048 

C IX(I) 1=1,.. ^LX INTEGER SERIES. IX(I) GRTHN 0, LSTHN OR * IXHI 0049 

C 0050 

C LX INTEGER. LENGTH OF IX SERIES. GRTHN ZERO 0051 

C 0052 

C N INTEGER. LAG OR SEPARATION FOR COUNT. CAN BE + 4-4 OR 0. 0053 

C XABS(N) LSTHN OR = LX 0054 

C 0055 

C IPU,J) I = l,..tIXHI»J=l,.. f IXHl SPACE FOR COMPUTATION OF 0056 

C FREQUENCY RATIOS. MAY BE EQUIVALENT TO P(HJ). WILL 0057 

C CONTAIN FREQUENCY RATIOS WHEN RETURN IS MADE If NO 0058 

C EQUIVALENCE HAS BEEN MADE. 0059 

C 0060 

C IXHI INTEGER. LARGEST VALUE IX TAKES ON. PROGRAM ASSUMES 0061 

C IXHI LSTHN OR * 25. MUST BE LSTHN OR EQUAL DIMENSION OF 0062 

C P(I,J) MATRIX. 0063 

C 0064 

C OUTPUTS 0065 

C 0066 

C P(UJ) 1 = 1,.. »IXHI,J=1,.., IXHI. PROBABILITY DENSITY FOR LAG OF N 0067 

C NORMALIZED SUCH THAT SUM OVER I AND J OF P(I,f) IS 1. 0068 

C 0069 

C IANS INTEGER. ERROR INDICATOR 0070 

C =0 NORMAL 0071 

C =-1 ILLEGAL IX VALUE. SOME IX LSTHN 1 OR GRTHN IXHI. 0072 

C =-2 ILLEGAL LX. LX LSTHN 1 0073 

C =-3 ILLEGAL N. XABSF(N) GRTHN LX. 0074 
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c 




*-6 ILtEGAL IXHI. IXHI GRTHN 26 


OR LSTHN 1 


* 






0075 


c 




*3 JOB DONE BUT N=0 AND ONLY CONTRIBUTIONS TO 


Off 

ri 1 


5.1 H ADC 


UU f o 


c 




UN Tnt DIAGONAL* 












0077 


c 
















0078 


C EXAMPLES 














0079 


L 
















0080 


C 1* 


INPUTS — 


lAliJ^U, LX=t> , N=l, IXHI :s 5 












008 1 


f 
v» 


Hi ITOMTC — 

UU 1 rU IS *~ 


TDIT | * — A D f T 1 \ — r\ T A M C — 1 

lPil,JJ-U , Pll,Jj— U , 1 Anl b = "~ I 












0082 


C 
















A AO 1 


U C.m 


TMDIITC 

1 NrU I b — 


r i u r »c cv turn c i e \/ m*» T t\z/t"» 

bAnfc Ab EXAMPLE 1 EXCEPT IXllJ 


= 1,2, 


3,4, 6 








0084 


C 


HI ITOIITC 

UUiPUlb — 


C AUC AC CVAUni C 1 

bAWfc Ab fcXAnPLfc 1 












UUoD 


C 
















0086 




I IMr U 1 b *~ 


CAMC AC CVAUDI C 9 CVTCDT 1 V — A 

bAWfc Ab EXAMPLE c. fcXttPI LX^U 












0087 


C 


UU 1 PU 1 b "~ 


I ANS-—2 












0088 


U 
















0089 


r* a 


t MDI ITC 

1 INPU 1 b "* 


CAMC AC CVAUDI C 9 CYPCDT I vut-n 
oAnt Ab CAAnrLt c. fcAUfcr 1 lAlil— U 












0090 




ni ITDI ITC _ 
UU 1 rU 1 b "~ 


I ANS=~6 












0091 


V. 
















AAQO 


C 5. 


INPUTS — 


bAnc Ab CAAMrLfc 4 EXCEPT IXHI—Z6 












0093 


C 


nilTOIITC 

UU 1 PU I b — 


I ANS 3S "*6 












0094 


u 
















0095 


r a 

i» o • 


T MDIITC — . 


SAMt Ab cXAMPLc c. fcXCEPI IXtPI—D 


, N*- 


■6 








0096 


r 


nilTOIITC — 
UU 1 rU 1 o 


I ANS-— 3 














v» 
















0098 


r 7 


TNPIITC. _ 
1 INrU 1 o 






>, 5, 1 , 


1,1,1 


:,lf 


1 1 
1,1 


A AQQ 


r 

v> 




lAfll-Dj LA s cl| IN— 1 












At AA 
U I UU 


r 


n 1 1 T D 1 1 T c — 
UU I r U 1 J 


T AW C — A 












AT A 1 
U iU 1 


v. 




L. *> r\ A n O 
t c. U U U • <t 


1 

p 1 


. 0 


* 0 


A 
. U 




A1 r\o 


U 




o 9 o f\ r\ n 
U £. C U U «U 


1 

• 1 


. 1 


. u 


A 
. V 




Al ft« 


r 
U 


T D f T I ) — 
lr III J — 


An i d/tii— n 

U U 1 41 U rUfJl- »U 


n 

• U 


nc 
• U3 


1 


A 
. U 




A 1 A it. 


c 
v. 




U U U 1 c • u 


• 0 


. 0 


• 05 


^ |^ 






** 

V, 




2 0 0 0 2 • I 


• 0 


. 0 


.0 


# \ 




0106 


C 
















Al A"7 


v. o. 


1 rir U 1 5 — 


CAMC AC CVAUDI C "7 CVfCOT Kl — 1 

bAnt Ab tXAnPLt # fcXufcPl N— ~ I 












01 08 


r 


nilTDIlTC — 
UU 1 rU lj * 


I AN S~ 0 












ni no 

UIU7 


r 

\> 
















At t A 
U 1 1 U 


C 




a n t\ r\ -o *> 
H U U U 4l • Z 


.0 


.0 


• 0 


.1 




A 1 t 1 
UI 11 


r 

V 




0 0 A A A 1 
C C U U U • 1 


.1 


.0 


.0 


.0 




AT 1 O 
U 1 1 £. 


c 
v» 


in i i 1 i _ 
lrlllJJ- 


U Z i U U PUi J I s • u 


• 1 


.05 


.0 


.0 




A 1 1 TL 
U 1 1 i 


r 
i> 




U U 2 I 0 «0 


• 0 


• 1 


.05 


• 0 




At 1 A 
U I 1 *t 


L 




A A A O O A 
U U U C C «U 


• 0 


.0 


• 1 


.1 




At 1 K 
Ui 1 D 


L 
















0116 


f* Q 

L V. 


INPUTS -""* 


bAMt Ab tXAWPLc f EXCEPT LX=Z4, 


N = 3 










A t 1 7 
U i 1 f 


c 


UUTPUTb — 


I ANS—0 












At i a 


c 




A. 1 O A A 1 O 

hizuu «iy 


.05 .1 


.0 




0 


At t Q 


c 




0 0 12 1 »0 


.0 


.05 


.1 


.05 


At OA 
Ul£U 


t 


IPC I , J) = 


AAAIO DfTIt— A 

U U U 1 c. r U| J ) s «U 


.0 


• 0 


.05 . 


1 


A 1 5 1 






2 0 0 0 1 .1 


.0 


• 0 


• 0 




05 


Al 95 


c 




2 2 0 0 0 .1 


.1 


.0 


.0 




0 


0123 


c 
















0124 


C10« 


INPUTS - 


SAME AS EXAMPLE 7 EXCEPT LX*20, 


N=0 










0125 


c 


OUTPUTS - 


IANS*3 












At 


c 
















At 97 


c 




6 0 0 0 0 .3 


.0 


.0 


.0 


.0 




0128 


c 




0 4 0 0 0 .0 


.2 


.0 


,0 


• 0 




A t ~> Q 


c 


IP(I,J)= 


0 0 3 0 0 PII,J)= .0 


.0 


.15 


*0 


.0 




At TLC\ 

U I 


c 




0 0 0 3 0 .0 


• 0 


.0 


*15 


.0 




0131 


c 




0 0 0 0 4 .0 


.0 


.0 


#0 


.2 




0132 


c 
















0133 




DIMENSION IX(IOGO) , I Pt 25,25 ) , P( 25, 25 ) 












0134 


c 


CHECK LX 
I ANS=-2 














A 1 IK 
U 1 3!> 

0136 




IE(LX) 9999,9999,? 












0137 


2 


IANS=-6 














0138 


c 


CHECK IXHI 












At %Q 




IF(IXHI) 


9999,9999,3 












0140 


3 


IF( IXHI-25) 4,4,9999 












0141 


c 


CHECK IX 


SERIES 












0142 


4 


IANS=~1 
DO 1 1=1 
IF(IXU) ) 


,LX 

9999,9999,11 












0143 
0144 
0145 


11 


IFUXU)- 


•IXHI) 1,1,9999 












0146 


1 


CONTINUE 
IANS=-3 














0147 
0148 


c 


CHECK N 














0149 
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IFCXABSF(N)-LX) 41,9999,9999 


0150 


41 


IANS=0 


0151 


C 


CLEAR IP(I,J) 


0152 




DO 5 1-1,25 


0153 




DO 5 J^l,25 


0154 


5 


IPU,J>=0 


0155 




IF(N) 6,7,8 


0156 


6 


LFRST=-N+1 


0157 




LLAST^LX 


0158 




GO TO 9 


0159 


7 


IANS=3 


0160 


8 


LFRST-1 


0161 




LLAST=LX-N 


0162 


9 


DO 10 I=LFRST, LLAST 


0163 




J= I X { I ) 


0164 




KK=I+N 


0165 




K=IX(KK) 


0166 


10 


IPt J,K)*IP( J,K)4-1 


0167 




L-LLAST-LFRST+1 


0168 




TQTAL=L 


0169 




DO 15 I=1,IXHI 


0170 




DO 15 J=1,IXHI 


0171 


15 


PU,J)=,FLOATFUP(I,J>)/TOTAL 


0172 


9999 


RETURN 


0173 




END 


0174 
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* PROCOR {SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 1498 

* FAP OOOl 
•PROCOR 0002 

COUNT 1500 0003 

LBL PROCOR 0004 

ENTRY PROCOR (X,LX, MAXX, PR0G1, PR0G2t ERR ) 0005 

ENTRY FASCOR ( Y t KMIN,KMAX,CORZER, ERROR) 0006 

ENTRY FASEPC (Y,KMIN,KMAX,CORZER, ERROR) 0007 

ENTRY FASCR1 { Y,KMIN,KMAX, CORZER, ERROR ) 0008 

ENTRY FASEP1 ( Y,KMI N, KMAX, CORZER, ERROR ) 0009 

* 0010 

* ABSTRACT 0011 

» 0012 

» TITLE - PROCOR WITH SECONDARY ENTRY POINTS FASCOR, FASEPC r FASCRl*FASEPl 0013 

* FAST CORRELATIONS FOR LONG SERIES OF FIXED POINT INTESERS 0014 

* 0015 

* PROCOR WRITES A MACHINE LANGUAGE PROGRAM DESIGNED TO 0016 

* COMPUTE AT HIGH SPEED A SINGLE FIXED POINT CROSS PRODUCT 0017 
» OF A GIVEN SERIES, Xd..»LX), WITH AN ARBITRARY SERIES* 0018 

* YU...LX), WHERE THE Y SERIES CAN BE LAGGED ARBITRARILY. 0019 

* SPEED OF ONE CROSS PRODUCT APPROACHES 2LX MACHINE CYCLES 0020 

* AS LX GETS LARGE WITH RESPECT TO MAXIMUM MAGNITUDE OF X 0021 

* {CONSIDERED AS 35 BIT-PLUS SIGN INTEGERS) « USER PROVIDES 0022 

* SPACE FOR OBJECT PROGRAM WHICH IS SOMEWHAT LONGER THAN 0023 
» X SERIES. ONCE THE PROGRAM IS GENERATED XCI) IS NO 0024 
» LONGER NEEDED AND THE PROGRAM IS REUSABLE. HIGH SPEED 0025 

* IS ATTAINED BY GROUPING MULTIPLIERS SO AS TO SUBSTITUTE 0026 

* SUMMATION FOR MULTIPLICATION AND BY CARRYING OUT THE 0027 
» SUMMATION BY A STRAIGHT LINE PROGRAM. FOR EXAMPLE IF 0028 
« XU...8) » I, 2,-1, 0,-2, 0, 1, 2 0029 

* Yd. #.8) « 2,-1, 2, 0, 1, 2,-2, 1 0030 

* THE CROSS PRODUCT 0031 

* i*2 * 2*i— ij — i*2 f 0*0 — 2 » I -r 0*2 ▼ l*\ — Z* t 2-1 CC32 

* WOULD BE COMPUTED BY THE OBJECT PROGRAM IN THE FORM 0033 
» (2 - 2 - 2)*l ♦ (- 1 - 1 + 1)»2 0034 

* 0035 

* FASCOR SUCCESSIVELY OPERATES THE PROGRAM GENERATED BY 0036 

* PROCOR TO PRODUCE A SPECIFIED TRANSIENT CORRELATION 0037 

* FUNCTION, XP(K), BETWEEN X(I) AND Yd) 0038 

* 0039 

* LX 0040 

* XP(K) * SUM ( X(I»»Yd+K) ) 0041 
» 1=1 0042 

* 0043 
» FOR K= KMIN,KMIN+1,.*., 0,1,.*., KMAX 0044 

* WHERE 0045 

* KMIN = NEGATIVE OR ZERO INPUT PARAMETER 0046 
» KMAX = POSITIVE OR ZERO INPUT PARAMETER 0047 

* Y(L) IS* FOR PURPOSES OF THE ABOVE EQUATION, 0048 

* CONSIDERED = 0 WHENEVER L FAELS OUTSIDE 0049 

* OF THE INCLUSIVE RANGE I TO LX (THIS 0050 

* IS THE TRANSIENT ASSUMPTION). 0051 
» Xd) IS RESTRICTED TO HAVE MAGNITUDES NOT 0052 

* EXCEEDING VALUE 1000 0053 
» 0054 

* FASEPC IS IDENTICAL TO FASCOR EXCEPT THAT IT DOfS 0055 

* NOT MAKE THE TRANSIENT ASSUMPTION ABOUT Yd*. 0056 
» 0057 
« FASCRl IS IDENTICAL TO FASCOR EXCEPT THAT XP(K) IS ADDED 0058 
» INTO THE OUTPUT AREA RATHER THAN BEING STORED INTO IT. 0059 

* (THIS IS A SPACE-SAVING FEATURE OF VALUE, FOR INSTANCE, 0060 

* WHEN DOING AVERAGED CORRELATIONS ON SEGMENTED SERIES-3 0061 

* 0062 

* FASEP1 IS IDENTICAL TO FASEPC EXCEPT THAT XP(K) IS ADDED 0063 
» INTO THE OUTPUT AREA RATHER THAN BEING STORED INTO 11* 0064 
» 0065 

* 0066 
» PROCOR IS SEPARATED FROM THE OTHER ENTRY POINTS TO PERMIT 0067 

* EFFICIENT COMPUTATION OF SUCCESSIVE CORRELATIONS OF XCI) 0068 

* WITH A SET OF OTHER SERIES, SAY Y( I ) , Z ( I ) , AND Wd ). IN 0069 
» THIS CASE PROCOR IS CALLED JUST ONCE TO ESTABLISH THE 0070 
» OBJECT PROGRAM SPECIALIZED TO THE X SERIES. THEN 0071 

* ANOTHER ENTRY IS CALLED SUCCESSIVELY FOR EACH OF THE 0072 

* OTHER SERIES. (AFTER THE CALL OF PROCOR Yd) CAN BE 0073 
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» MOVED INTO THE X(I) AREA TO SAVE SPACE IF NECESSARY.) 0074 

* 0075 

* BY PROPER SEQUENCES OF CALLS THESE PROGRAMS CAN BE USED 0076 

* TO PRODUCE AUTOCORRELATIONS, CROSS CORREL ATiONSr AND 0077 
» CONVOLUTIONS, FOR EITHER EQUAL LENGTH OR UNEQUAL LENGTH 0078 

* SERIES, AND FOR EITHER THE TRANSIENT OR FOR THE EQUAL- 0079 

* PRODUCTS ASSUMPTION. 0080 
» 0081 

* LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0082 

* EQUIPMENT - 709, OR 7090 (MAIN FRAME ONLY) 0083 
» STORAGE - 770 REGISTERS 0084 

* SPEED - PROCOR TAKES ABOUT 0085 
» 64«LX + 78*MAXX MACHINE CYCLES 0086 
» WHERE MAXX = MAXIMUM MAGNITUDE OF X(l) 0087 

* FASCCR TAKES ABOUT 0088 

* 120*MAXX ♦ (KMAX+1)*(2*LX - KMAX ♦ 20*MAXX) 0089 

* ♦ KMN*(2»LX - KMN + 20»MAXX) MACHJ CYCLES 0090 

* WHERE KMN = MAGNITUDE OF KM IN 0091 
» FASEPC TAKES ABOUT 0092 

* 120*MAXX + (KMAX+KMN+1)»(2*LX+9*MAXX) MACH. CYCLES 0093 

* FASCR1 TAKES THE SAME TIME AS FASCOR 0094 

* FASEP1 TAKES THE SAME TIME AS FASEPC 0095 
» 0096 

* AUTHOR - S.M. SIMPSON JR, 10/15/62 0097 

* 0098 
» 0099 
» 0100 

* — — USAGE OF PRGCOR-FASCOR-FASEPC-FASCRl-FASIPt 0101 

* 0102 
« TRANSFER VECTOR CONTAINS ROUTINES - NONE 0103 

* AND FORTRAN SYSTEM ROUTINES - NONE 0104 

* 0105 
» FORTRAN USAGE OF PROCOR 0106 

* CALL PROCOR(X,LX, MAXX, PR0G1,PR0G2, ERR) 0107 

* 0108 

* INPUTS TO PROCOR 0109 

* 0110 
« XU) 1 = 1,2,*.. ,LX IS A SERIES OF MACHINE LANGUAGE INTEGERS 0111 
» (BINARY POINT BEYOND BIT 35). 0112 

* ALL HAVE MAGNITUDES LESS THAN OR * MAXX 0113 
» 0114 

* LX IS A FORTRAN INTEGER GREATER THAN OR = 1 0115 
» 0116 
» MAXX IS A FORTRAN INTEGER » UPPER BOUND TO X(I) SERIES* 0117 

* MUST LIE BETWEEN 1 AND 1000 INCLUSIVELY. FOR MAXIMUM 0118 

* SPEED MAXX SHOULD BE MADE AS SMALL AS POSSIBLE 0119 

* 0120 

* PR0G1 WILL BE THE FIRST INSTRUCTION OF THE OBJECT PROGRAM 0121 

* PROGl TO PR0G2 IS TO BE MADE AVAILABLE FOR THE 0122 
» PROGRAM WHOSE LENGTH DEPENDS ON BOTH LX AND MAXX 0123 
» 0124 
» PR0G2 DEFINES HIGH ADDRESS END OF SPACE BLOCK AVAILABLE 0125 

* FOR PROGRAM. PROGl AND PR0G2 MUST SATISFY 0126 

* XL0CF(PR0G2) - XL0CFIPR0G1) EQUALS OR EXCEEDS 0127 

* LX + 10MMAXX+1) 0128 
« 0129 
« OUTPUTS FROM PROCOR 0130 

* 0131 

* THE PRINCIPLE OUTPUT IS THE PROGRAM STORED IN 0132 

* MACHINE ACDRESSES PROGl, PR0G1+1, ... 0133 

* 0134 

* ERR * 0.0 IF NO TROUBLE ARISES 0135 

* * 1.0 IF OBJECT PROGRAM HAS INADEQUATE SPACE 0136 
» « 2.0 IF ILLEGAL LX 0137 
» * 3.0 IF SOME X(I) EXCEEDS MAXX 0138 

* » 4.0 IF MAXX IS ILLEGAL 0139 

* 0140 

* 0141 

* FORTRAN USAGE OF FASCOR 0142 

* CALL FASCOR! Y,KMIN, KMAX, C0R2ER, ERROR) 0143 
» 0144 

* INPUTS TO FASCOR C145 

* FASCOR ASSUMES PROCOR HAS ESTABLISHED ITS OBJEGT PROGRAM 0146 

* 0147 

* Yd) 1 = 1.. .LX IS A SERIES OF MACHINE LANGUAGE INTEGERS TO BE 0148 
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» CORRELATED WITH XU). Yd) DOES NOT HAVE TO BE 0149 

* BOUNDED BY MAXX AS X(I) IS, BUT FIXED POINT OVERFLOW 0150 
» IS POSSIBLE, 0151 
» 0152 

* KMIN IS LARGEST NEGATIVE LAG DESIRED IN CORRELATION 0153 
« IS A FORTRAN INTEGER EXCEEDING -LX AND LSTHN* 0 0154 
« 0155 
» KMAX IS LARGEST POSITIVE LAG DESIRED IN CORRELATION 0156 

* IS A FORTRAN INTEGER GRTHN*0 AND LSTHN LX 0157 
» 0158 

* OUTPUTS FROM FASCOR 0159 
» 0160 

* CORZERU) 1= -KMN+l,~KMN+2, ...,0, 1,...,KMAX+1 WILL CONTAIN 0161 

* THE CROSS PRODUCTS XPC KMIN, . . . ,KMAX) WHERE XPtKI 0162 

* IS DEFINED IN THE ABSTRACT ABOVE, 0163 

* AND KMN = MAGNITUDE OF KMIN* 0164 

* fcTHIS STORAGE FORMAT PLACES XP<0) IN C0RZER(l)J> 0165 

* THE CROSS-PRODUCTS ARE MACHINE LANGUAGE INTEGERS 0166 
» AS ARE X AND Y. OVERFLOW IS POSSIBLE IF Y DOES NOT 0167 

* HAVE REASONABLE BOUNDS. (PROGRAM EXITS IMMEDIATELY 0168 

* WHEN AN OVERFLOW IS DETECTED.) OVERFLOW IS IMPOSSIBLE 0169 

* IF LX»MAXX*MAXY IS LESS THAN 2EXP35 (APPROX 3*10EXP10) 0170 
» WHERE MAXY = MAXIMUM Y MAGNITUDE* 0171 
» 0172 

* ERROR * 0.0 NORMALLY 0173 

* » 1.0 IF OBJECT PROGRAM NOT YET WRITTEN 0174 

* * 2.0 FOR ILLEGAL KMIN OR KMAX (NO COMPUTATIONS MADE) 0175 

* = 3.0 IF OVERFLOW OCCURS AT SOME LAG. I IF THIS 0176 

* HAPPENS PROCOR MUST BE OPERATED AGAIN 0177 

* BEFORE CALLING FASCOR AGAIN. (FASCOR FAIL $ TO 0178 

* DETECT ONE KIND OF OVERFLOW - SEE NOTES ON 0179 

* EXAMPLES l.» 19., AND 20. BELOW) 0180 

* GIG 1 
» FORTRAN USAGE OF FASEPC 0182 

* CALL FASEPC f Y, KMIN, KMAX, CORZER, ERROR ) 0183 
» 0184 

* INPUTS TO FASEPC 0185 

* 0186 
» IDENTICAL TO THOSE OF FASCOR EXCEPT THAT THE 0187 
» MAGNITUDES OF KMIN AND KMAX ARE NOT RESTRAINED BY 0188 
» ANY UPPER BOUND. 0189 

* 0190 

* OUTPUTS FROM FASEPC 0191 
» 0192 

* IDENTICAL TO THOSE OF FASCOR EXCEPT THAT THE 0193 
» COMPUTATION OF XP(K) DOES NOT ASSUME THAT Y(L* * 0 0194 

* WHEN L IS OUTSIDE THE INCLUSIVE RANGE 1 TO LX . 0195 
» 0196 

* FORTRAN USAGE OF FASCR1 0197 
» CALL FASCRKY, KMIN, KMAX, CORZER, ERROR) 0198 

* 0199 
» INPUTS TO FASCR1 0200 

* 0201 

* IDENTICAL TO THOSE OF FASCOR 0202 
« 0203 
» OUTPUTS FROM FASCR1 0204 
» 0205 

* IDENTICAL TO THOSE OF FASCOR EXCEPT THAT XP IS ADDED TO 0206 

* CORZER* IE CORZER(I) » CORZERU) ♦ XPU-1) . 0207 
» 0208 

* FORTRAN USAGE OF FASEP1 0209 

* CALL FASEP1 < Y, KM I N, KM AX, CORZER, ERROR) 0210 
» 0211 

* INPUTS TO FASEP1 0212 

* 0213 

* IDENTICAL TO THOSE OF FASEPC. 0214 
» 0215 

* OUTPUTS FROM FASEP1 0216 

* 0217 
« IDENTICAL TO THOSE OF FASEPC EXCEPT THAT XP IS ADDED TO 0218 
» CORZER, IE CORZERU) * CORZER( I ) ♦ XPU-1) . 0219 

* 0220 

* EXAMPLES 0221 

* 0222 
» THE NOTATION ML I , USED BELOW, STANDS FOR MACHINE LANGUAGE 0223 
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* 1, 



INTEGERS, I.E. FIXED POINT INTEGERS WITH BINARY POINT TO 
RIGHT OF BIT 35. OTHERWISE FORTRAN II CONVENTIONS ARE 
USED WITH RESPECT TO NUMERICAL CONSTANT REPRESENTATION, 
TO INDEXING OF VARIABLES, ETC. 

THE OUTPUTS ERR AND ERROR ARE «0.0 IN THE EXAMPLES BELOW 
UNLESS OTHERWISE STATED. 

THE INPUTS IN ALL EXAMPLES ARE THE SAME AS 
THOSE OF EXAMPLE 1. UNLESS OTHERWISE STATED. 

ILLUSTRATION OF OBJECT PROGRAM FORMATS THIS EXAMPLE ONLY FOR THOSE 

INTERESTED IN PROCOR LOGIC) 
INPUTS - SET X(I...20)= ML I 1 ,0,-3* 3,-3,-0, 1 , 0,-3,-3, @.» 0,. i * 
YU...20)*: ML I 1, 1,1, 1,1, 0,0, 0,0, 0*0*1 ,0,f0»0,.>4* 
Z! 1...20)= ML I 10, 10, 10, 10, 10, 0,0, 0,0, 0,0, 104010, * i 
C0R!1.*.50)= ML I 0,0,..* U.E. CLEAR OttTPUT AREA! 

CALL PR0C0R(X, 10, 3, SPACE ( 100), SPACE ( 1),ERR1 
FAP OBJECT PROGRAM BELOW 

N+l=ll 



USAGE 

OUTPUTS - THE 



» 


SPACE* 100) 


PZE 


3 


* 


* 


PZE 


2 


» 




PZE 


1 


* 




PZE 


0 


* 


SPACE ( 96 ) 


CLA 


9,1 


• 




SUB 


5,1 


* 




ADD 


3,1 


* 




PZE 


0 


* 




PZE 


0 


• 




PZE 


0 


* 




PZE 


0 


* 




PZE 


0 


• 


SPACE!88) 


CLA 


10, 1 


» 




ADD 


4,1 


» 




XCA 




* 




MPY 


SPACE! 98 ) 


* 




XCA 




* 




ADD 


SUM 


* 




STO 


SUM 


• 


SPACE181) 


CLS 


8,1 


* 




ADD 


7,1 


* 




SU8 


6,1 


• 




SUB 


2,1 


• 




SUB 


1,1 


* 




XCA 




• 




MPY 


SPACE! 100) 


• 




XCA 




* 




ADD 


SUM 


• 




STO 


SUM 


* 


SPACE 171) 


TRA 


1,4 



{ SPACEI 88) IS ENTRY PT. 
TO OBJECT UROGRAM) 



! SUM IS AN INTERNAL 
ADDRESS IN PROCOR 1 

!NOTE-NO BLOCK EXISTS 
FOR MAGNITUDES X(I)» 
2) 



SPACE!70) 
SPACE(65) 
SPACE(48) 
! NOTE THAT IF 



THRU SPACE! 66) * 0 SINCE NO X = 2 OR -2 
THRU SPACE<49) IS TABLE SPACE FOR FASCOR. 
THRU SPACE(l) IS EXTRA SPACE NOT USED* 
THE RESULT OF AN MPY INSTRUCTION EXCEEDS 



♦ 2. 



35 BITS THIS SHOULD BE CONSIDERED AN OVERFLOW SUT IT 
WILL NOT BE CAUGHT.) 

COMPLETE TRANSIENT CROSS-CORRELATION OF XII. ..5) WITH YU.J.5I 
» USAGE - CALL PROCOR! X , 5, 3, SPACE! 100 ), SPACE! 1} , ERR) 

« CALL FASCOR ( Y ,—4*4, COR! 5) , ERROR ) 

* OUTPUTS - C0RU...19) * ML I -3,0,-3,-3,-2, 1,-2,1, 1*0*0, ..U 
• 

* 3. COMPLETE TRANSIENT AUTO-CORRELATION OF XII. ..5) 
CALL PROCOR! X ,5,3, SPACE! 100) , SPACE! 1 J ,ERR ) 
CALL FASC0R!X,0,4,C0R! I), ERROR) 

0RC1...19) = ML I 28,-18,6,3,-3,0,0,..* 



CALL PROCOR! X, 5, 3, SPACE! 100), SPACE! 1),ERR) 
CALL FASCOR! X, 0,2, COR! 1), ERROR) 
.*.19) a ML I 28,-18,6,0,0,.*. 



PROCOR, TO STORE CORRELATION 

CALL PROCOR! X, 5, 3, SPACE ( 100) , SPACE ! 1 J, ERR) 

CALL FASCOR! Y ,-2 ,2,X ! 3 ), ERROR ) 
XU...15) « ML I -3,-3,-2, 1,-2,-0, 1,0, -3, -3#0,0#... 



» 




USAGE 


* 






• 




OUTPUTS 


• 






• 


4. 


PARTIAL 


• 




USAGE 


* 






* 




OUTPUTS 


• 






• 


5. 


PARTIAL 


* 






* 




USAGE 


* 






» 




OUTPUTS 


* 







0224 
0225 
0226 
0227 
0228 
0229 
0230 
0231 
0232 
0233 
0234 
0235 
0236 
0237 
0238 
0239 
0240 
0241 
0242 
0243 
0244 
0245 
0246 
0247 
0248 
0249 
0250 
0251 
0252 
0?53 
0254 
0255 
0256 
0257 
0258 
0259 
0260 
0261 
0262 
0263 
0264 
0265 
0266 
0267 
0268 
0269 
0270 
0271 
0272 
0273 
0274 
0275 
0276 
0277 
0278 
0279 
0280 
0281 
0282 
0283 
0284 
0285 
0286 
0287 
0288 
0289 
0290 
0291 
0292 
0293 
0294 
0295 
0296 
0297 
0298 
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» 6. REPEATED PARTIAL TRANSIENT CROSS-CORRELATION OF X( 1.^.5) WITH 0299 

• Yd.. .5) AND WITH Zd..i.5) 0300 

• USAGE CALL PROCOR ( X, 5, 3, SPACE ( 100 ) t SPACEf 1),ERR) 0301 

• CALL FASC0R(Y,~2,2,C0R(5),ERR0R) 0302 
» CALL FASCOR(Z,-2,2,COR( 15), ERROR) 0303 

• OUTPUTS - C0R(1...20) * ML I 0,0,-3, -3,-2, 1,-2,0,0, 0,0, 0,-30^-30* 0304 

• -20,10,-20,0,0,0 0305 

• 0306 

• 7. REPEATED PARTIAL TRANSIENT CROSS-CORRELATION OF X(1...5) WITH 0307 
» Y(l. ..5) AND WITH Z(1...5) WITH SUMMATION OF OUTPUT 0308 
« CORRELATIONS. 0309 

• USAGE - CALL PR0C0RIX,5,3,SPACE( 100), SPACE! 1),ERR) 0310 
» CALL FASCORl Y,-2 , 2,C0R( 3 ) , ERROR ) 0311 

• CALL FASCR1(Z,-2,2,C0R(3),ERR0R) 0312 

• OUTPUTS - CORU.4.20) = ML I -33,-33,-22,11,-22,0,0,... 0313 

• 0314 
» 8. EQUI— PRODUCTS CORRELATION OF XU.W5) WITH Y(I) SUCH THAT I STAYS 0315 

• IN THE RANGE 1...20 0316 

• USAGE - CALL PROCOR* X , 5, 3, SPACE ( 100) ,SPACEI I), ERR) 0317 

• CALL FASEPC (Y( 16) ,— 15,0, COR ( 16), ERROR) 0318 
« OUTPUTS - C0R(1.*.16) = MLI -2,1,-2,1,1,0,0,-3,3,-3,0,1,0,010,0 0319 

• 0320 

• 9. EQUI-PRODUCTS CORRELATION OF XC1...5) WITH Yd) AND WITH ZII), 0321 
« I IN THE RANGE 1...20, WITH SUMMATION OF OUTPUT 0322 

• CORRELATIONS. 0323 

• USAGE - CALL PROCOR C X,5,3, SPACE( 100 ) , SPACE < 1 1, ERR ) 0324 
» CALL FASEPC(Y(16),-15,0,C0R( 16), ERROR) 0325 
» CALL FASEP1(Z( 16 ) ,— 15, 0,COR( 16), ERROR) 0326 

• OUTPUTS - C0R(1...16) » MLI -22,11,-22,11, 11,0,0,-33*33,-33,0*11,0, 0327 

• 0,0,0 0328 

• 0329 
•10. COMPLETE TRANSIENT CROSS-CORRELATIONS OF UNEQUAL LENGTH SERIES, 0330 
» At !•••!>) w i i n Yii«..l2i, 3V IMGH^T ICN CT" LCACIEC AMD 0331 

• TERMINAL ZEROES AND USING FASEPC 0332 
» INPUTS - X(1...5> AND Yd. ..12) AS IN EXAMPLE 1. INSERT 4 ZEROES 0333 
» AT EACH ENO OF Yd) BY LETTING W(1...4)»0 W(5...16)* 0334 
» Yd. ..12) W(17...20)=0 0335 

• USAGE - CALL PROCOR ( X, 5, 3, SPACE ( 100), SPACE { 1},ERR) 0336 
» CALL FASEPC(W( 16),-15,0,C0R( 16), ERROR) 0337 

• OUTPUTS - C0RU...16) = ML I -3,0,-3,-3,-2, 1,-2, 1,1, 0*0,-3, 3#-3| 0, 1 0338 

• 0339 
♦11. COMPLETE TRANSIENT CROSS-CORRELATIONS OF UNEQUAL LENGTH SERIES* 0340 

• Xd...5) WITH Yd. ..12) USING FASCOR FOR END EfFECTS AND 0341 

• FASEPC FOR CENTRAL VALUES 0342 

• USAGE - CALL PROCORC X, 5, 3,SPACE( 100 ) , SPACE (1>, ERR ) 0343 

• CALL FASC0R(Y,-4,0*C0R(5),ERR0R) 0344 
» CALL FASEPC (Y (7) ,-5,0,C0R( 11), ERROR ) 0345 

• CALL FASC0R( Y(8) ,0,4, COR ( 12), ERROR) 0346 

• OUTPUTS - C0R(1...16) = MLI -3,0,-3,-3,-2, 1,-2, 1, 1*040, -3, 3,-3§0,l 0347 

• NOTE- THE GENERAL FORMAT IN THIS CASE FOR 0348 
» Xd...LX) Y(1...LY) WITH LX LSTHN LY IS 0349 

• N1=-LX+1 0350 
» N2= LY-LX 0351 
» N3*-(LY-LX-2) 0352 

• N4= LY-1 0353 

• N5= LY-LX+1 0354 

• N6= LX-1 0355 
» CALL PROCOR! X,LX,MAXX,PR0G1,PR0G2,ERR) 0356 

• CALL FASCORt Y,N1 ,0,COR(LX», ERROR) 0357 

• (OMIT IF N3=l) CALL F ASEPC ( Y ( N2 ) , N3, 0, COR ( N4 I, ERROR) 0358 

• CALL FASCOR(Y(N5),0,N6,COR(LY*,ERftOR! 0359 

• WHICH LEAVES CORRELATION IN C0Rd,2, i..,LX+LY-l) 0360 
« 0361 

• 12. COMPLETE CONVOLUTION OF TWO UNEQUAL LENGTH SERIES Xd...5) WITH 0362 
» Yd. ..12) 0363 

• INPUTS - SAME AS EXAMPLE 1. EXCEPT REVERSE X(I) I.E* Xd.«1.55*-3, 0364 

• 3,-3,0,1 0365 
« USAGE - SAME AS EXAMPLE 11. 0366 
» OUTPUTS - C0R11...16) = MLI 1, 1,-2, 1,-2, -3, -3, 0,-3*0^0, U0,-3, 3, -3 0367 
» 0368 
•13. EXAMPLES 13. THROUGH 20. ILLUSTRATE ERROR CONDITIONS^ 0369 

• USAGE - CALL PR0C0R( X, 5, 3 , SPACE ( 45) , SPACE( 1)»ERR> 0370 

• OUTPUTS - ERR^l.O (SPACE BLOCK TOO SMALL) 0371 
» 0372 
♦14. USAGE - CALL PROCOR(X,0,3,SPACE(100),SPACE(1>,ERR) 0373 
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* OR GALL PR0COR(X,15000,3,SPACE(200OO),SPACEUltERRI 0374 

* OUTPUTS - ERR=2.0 (ILLEGAL LX) 0375 
» 0376 

* 15. USAGE - CALL PROCOR( X, 5, 2, SPACE( 100 ) , SPACE< U,ERR) 0377 

* OUTPUTS - ERR=3.Q (X(I) FOUND GREATER THAN MAXX) 0378 

* 0379 
♦16. USAGE - CALL PR0C0R(X»5»0,SPACE( 100), SPACE! II « ERR) 0380 

* OR CALL PROCOR (X, 5, 1 100, SPACE! 5000) , SPACE! I H, ERR I 0381 

* OUTPUTS - ERR*4.0 (ILLEGAL MAXX) 0382 

* 0383 

* 17. USAGE - CALL PROCOR ( X,0, 3, SPACE ( 100 ) » SPACE I I) ,ERRJ 0384 

* CALL FASCOR(Y, -4,4, C0R(5), ERROR) 0385 
« OUTPUTS - ERR=2.0 (SAME AS EXAMPLE 14,) 0386 

* ERROR * 1.0 (NO OBJECT PROGRAM) 0387 

* 0388 
•18. USAGE - CALL PROCQR(X, 5,3, SPACE( 100), SPACE! U, ERR) 0389 
» CALL FASC0R(Y,-5,4,C0RI 10),ERRQR) 0390 

* OR CALL FASCOR(Y, 2 ,4, CORC 10 ) , ERROR ) 0391 

* OR CALL FASC0R(Y,-4,6,C0R( 10), ERROR) 0392 

* OR CALL FASC0R(Y,-4,-l,C0R(10), ERROR) 0393 

* OUTPUTS - ERR=0.0 0394 

* ERR0R=2.0 (ILLEGAL KMIN OR KMAX ) 0395 
» 0396 

* 19, INPUTS - XU...5) = MLI 20,40,60,80,100 0397 
« Yd. ..5) = ML I 200000000,200000000,... =0C T 001372741000 0398 

* USAGE - CALL PROCOR ( X,5, 100, SPACE ( 10 16), SPACE! 1 ) #ERR) 0399 

* CALL FASCOR(Y, 0,0, COR, ERROR) 0400 

* OR CALL FASEPC(Y, 0,0, COR, ERROR) 0401 

* OR CALL FASCR1 ( Y, 0,0, CCR, ERROR) 0402 

* OR CALL FASEPKY, 0*0, COR, ERROR) 0403 

* OUTPUTS - ERR^O.O ERR0R=3.0 (OVERFLOW CAUGHT, COR( I )=6#10EXP10) 0404 
» 0405 
•20. INPUTS - SAME AS EXAMPLE 19. EXCEPT X(1...5) = 60,60,60,60,60 0406 

* USAGE - SAME AS EXAMPLE 19. 0407 

* OUTPUTS - ERR=0.0 ERROR=0.0 (OVERFLOW NOT CAUGHT) 0408 

* 0409 
♦21. SPECIAL CASE TEST - ALL X(I) ARE ZERO (PROGRAM HAS BYPASS FOR THIS) 0410 

* INPUTS - XU...5) = MLI 0,0,... 0411 

* Yd. ..10) * MLI 5,4,3,2,1,0,-1,-2,-3,-4 0412 

* CORd..*.) = MLI 1,2,3,4,5,6,7,8,... 0413 
» USAGE - CALL PR0C0R(X,5, 10,SPACE( 200) , SPACE, ERR) 0414 
» CALL FASCOR(Y, 0,4, COR, ERROR) 0415 

* OR CALL FASEPC(Y(5),-4,0,C0R(5),ERR0R) 0416 

* OUTPUTS - CORd.i.) « MLI 0,0,0,0,0,6,7,8,... 0417 
» 0418 
♦22. INPUTS - SAME AS EXAMPLE 21. 0419 

* USAGE - CALL PROCOR ( X, 5, 10, SPACE ( 200 ) , SPACEtERR) 0420 
» CALL FASCRKY, 0,4, COR, ERROR) 0421 

* OR CALL FASEPl(Y(5f, -4,0, C0R!5), ERROR) 0422 

* OUTPUTS - CORd...) = MLI 1,2,3,4,5,6,7,8,... 0423 

* 0424 
•23. SPECIAL CASE TEST - X SERIES HAS LENGTH = 1 . 0425 

* INPUTS - SAME AS EXAMPLE 21. EXCEPT X(l) * ML I 2 0426 

* USAGE - CALL PR0C0R( X, 1 , 10, SPACE ( 200 ), SPACE, ERR ) 0427 

* CALL FASCOR(Y, 0,0, COR, ERROR) 0428 

* OUTPUTS - CORdw.) * MLI 10,2,3,4,5,6,7,8,... 0429 

* 0430 
•24. INPUTS - SAME AS EXAMPLE 23 . 0431 

* USAGE - CALL PROCOR ( X, 1, 10, SPACE ( 200), SPACE, ERR) 0432 

* CALL FASEPC(Y(5),-4,2,C0R(5),ERR0R) 0433 

* OUTPUTS - CORd...) * MLI 10,8,6,4,2,0,-2,8,9,... 0434 
» 0435 
» 0436 

* PROGRAM FOLLOWS BELOW 0437 

* NOTATION DIFFERENCES BELOW ARE 0438 
» N * LX 0439 

* POSMAX = KMAX 0440 

* NEGMAX = KMIN 0441 

* T * K « LAG NUMBER 0442 

* S=MAXX 0443 

* 0444 
HTR 0 0445 
HTR 0 0446 
HTR 0 0447 
BCI 1, PROCOR 0448 
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0449 




Donrno- 


3,2 




0450 


C YO 


do nr n d— 


2,4 




045 1 




> A IN U O JZ 1 


X+l 


ADDRESSES 


0452 




J. » «► 






0453 


ex* 
o 1 A 


T 1 






0454 


ADO 


Kl 






0455 


STA 


A£U 






0456 


O 1 A 


Y4. 1 
A*t L 






045 7 




X44 






0458 


5 1 A 


A*f o 






0459 


* UC 1 IN VALUE 


AMD CCT 
AINU OC 1 


DECREMENTS, ETC { AFTER CHECKING N) 


0460 


f 1 A 
l*L A 






K5=2.0 


0461 


o 1 U 


I £ I 






0462 


r i a «. 

V/LA* 


2 , 4 




= N 


0463 




1 <l 






0464 


TM T 


YAK 






0465 


T 7C 


X65 






0466 


r AC 






K8= 0,0,10000 


0467 


T D A 
1 KA 


X65 






0468 


Kino 
viXJr 








0469 


c Tn 


X24 






0470 


STO 








U*f f I 


ARS 


A o 






UH 1 C. 


CTA 
O I A 


T7 






047 3 




Til 






0474 


• HPT <I \/AI IIP 


AMn Q£T 


DECREMENTS (AFTER CHECKING S) 




CL A 


K29 




K29= 4.0 


U*f f O 


STO 


T27 








CLA* 


3,4 




= S 


C\ L.~f ft 


STO 


T3 






0479 


TMI 


X65 






U*rO u 




AO J 








CAS 


K30 




K30= 0,0,1000 




TRA 


X65 








NOP 








0484 


STD 


X36 






048 5 


STD 


X63 






0486 


•MAKE OBJECT PROGRAM SIZE 


CHECK 




CIA 


K4 




K4= 1.0 


ClL. ft ft 


STO 


T27 






048 9 


CLA 


4,4 








STA 


T4 






049 1 


CAL 


5,4 




FORM 




ANA 


K20 








SUB 


T4 




PR0G2-PR0G1 




STA 


T17 








CLA 


T3 




GET S (IN DECR) 




ADD 


K7 




S + l 


0497 


XCA 










MPY 


K31 




K31= 10 


0499 


XCA 






10CS+11 


UDUU 


ADD 


T2 




N+10(S+1) 


n*%n i 

U ->U i 


ARS 


18 




MOVE TO ADDRESS 


0502 


CAS 


T17 




COMPARE WITH PR0G2-PR0G1 


0503 


TRA 


X65 






0504 


TRA 


♦+1 




OK 


0505 


* CLEAR PR0G1 


THRU PROGl+N + lOCS+U 


0506 


• (LOOP TAKES 


3<N*10(S+1)+1) HI SPEED INSTRUCTIONS) 


0507 


ADD 


Kl 




N+10(S+1)+1 


UDUo 


ADD 


T4 




PR0G1 + DITTO 




STA 


X2 






05 1 0 


SUB 


T4 






05 1 1 


ALS 


18 




N+10(S+1)+1 IN DECR 




STD 


X3 






05 1 3 


LXD 


K7,l 




K7= 0,0,1 


0514 


X2 STZ 


♦*,1 


** 


= PR0GH-N>10(S + 1) + 1 


0515 


TXI 


•+1,1,1 






0516 


X3 TXL 


X2, 1,** 


** 


=N+10(S+1)+1 


0517 


♦SET ADDRESSES 


-PR0G1+S 


AND 


PR0G1+S+1 


0518 


CLA 


T3 






0519 


ARS 


18 






0520 


ADD 


T4 






0521 


STA 


X62 






0522 


STA 


T9 




DEFINES TABLE 


0523 
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ADD 




Kl 






0524 




STA 




T12 






0525 


♦SET ADDRESSES 


STABLE, 


TABLE+1, T A8LE-S 




0526 




CLA 




T9 


TABLE 




0527 




STA 




X25A 






0528 




STA 




X25 






0529 




STA 




X21 






0530 




STA 




X22 






0531 




STA 




X24A 






0532 




STA 




X26 






0533 




STA 




X29 






0534 




STA 




X30 






0535 




STA 




X31 






0536 




STA 




X42 






0537 




STA 




X43 






0538 




STA 




X47 






0539 




ADD 




Kl 


TABLE+1 




0540 




STA 




X28 






0541 




STA 




X32 






0542 




CLS 




T3 






0543 




ARS 




18 






0544 




ADD 




T9 


T ABLE— S 




0545 




STA 




X37 






0546 


* FORM 


ADDRESSES OF TABLl, TABL2,TABL3, TABL4 


0547 




CLA 




T3 


SET S+l 




0548 




ADD 




K7 






0549 




ARS 




18 






0550 




STA 




T18 






0551 




ALS 




2 


4(S+U 




0552 




ADD 




T18 


5(S+1) 




0553 




ADD 




T18 


6(S+1) 




0554 




ADD 




T12 


PR0Gl+S+l+6( S+l) 


0555 




ADD 




Til 


PRQGl+S+l+N+6( S + U-TABLl 


0556 




STA 




T13 






055 7 




ADD 




T18 


TABL2 




0558 




STA 




T14 






0559 




ADD 




T18 


TABL3 




0560 




STA 




T15 






0561 




ADD 




T18 


TABL4 




0562 




STA 




T16 






0563 




CLA 




T13 


SET TABL1 ADDRESSES 


0564 




STA 




X22A 






0565 




STA 




X28A 






0566 




STA 




X26A 






0567 




STA 




X338 






0568 




SUB 




Kl 






0569 




STA 




X37A 






0570 


♦ SCAN 


X VALUES 


TO MAKE FREQUENCY COUNT OF 


MAGNITUDES IN 


0571 


♦DECRE 


MENTS 


OF 


TABLE 


AND TABL1, CHECKING 


FOR EXCESSIVE X MAGNITUDES 


0572 


♦ (THIS 


LOOP 


TAKES ION 


HI SPEED INSTRUCTIONS) 


0573 


X19 


AXT 




1,2 






0574 




CLA 




K6 


K6 = 3.0 




0575 




STO 




T27 






0576 


X20 


CLA 




♦ ♦,2 


(#*=X+1) 


GET MAGNITUDE OF NEXT X VALUE 


0577 




SSP 








AND INCREMENT 


0578 




CAS 




T18 


T18= S+l 




0579 




NOP 










0580 




TRA 




X65 






0581 




PAX 




0,4 




THE 


0582 


X21 


CLA 




♦ ♦,4 


( ♦♦sTABLE ) 


PROPER 


0583 




ADD 




K7 


(K7=PZE0,0, 1) 


COUNTER 


0584 


X22 


STO 




♦ ♦#4 


(♦♦=TABLE) 


BY ONE 


0585 


X22A 


STO 




♦♦,4 


(♦♦sTABLl) 




0586 


X23 


TXI 




♦♦1,2, 


1 




0587 


X24 


TXL 




X20,2, 


*♦ (t*=N) 




0588 




STZ 




T27 


ALL OK 




0589 


♦CHECK 


IF ALL 


X ( I ) = 


0 . IF SO SET FASCOR BYPASS SWITCH AND EXIT 


0590 




CLA 




Kl 






0591 




STO 




T29 






0592 


X24A 


CLA 




• * 


♦♦STABLE N(0) 




0593 




CAS 




T2 


T2= N 




0594 




HPR 




* 


IMPOSSIBLE 




0595 




TRA 




X65 


BYPASS 




0596 




STZ 




T29 


OK 




0597 



♦NOW SET UP ADDRESS TABLE FOR BLOCKS IN OBJECT PROG. AND INSERT 5-GROUPS 0598 
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•SEE FORMAT OF THIS 


TABLE IN NOTES BELOW 




0599 


* (NOTE XCAtO) » LOC(O) ♦ N(O) IF N(O) NON ZERO 




0600 


• 


38 LCC(Q) - 5 IF N(O) * 0 




0601 




LOC(O) * PROGl ♦ S + 1 ) 




0602 


X25 


CLA ♦♦ 


(♦♦^TABLE) GET N(0) 




0603 




ARS 18 






0604 




TZE X26B 






0605 


X25B 


ADD T12 


N(0)+PROGl+S+l 




0606 


X25A 


ADD ♦♦ 


( ♦♦sTABLE ) 




060 7 




SSM 


MZE XCA(0),0,N(0) 




0608 


X26 


STO ♦♦ 


(♦♦^TABLE) 




0609 




CLA T12 


SET LOC(O) 




0610 


X26A 


STA ♦♦ 


(♦♦=TABL1) IN TABL1 




0611 




TRA X26C 






0612 


X26B 


CLS K9 


-5 IF N(0)-0 




0613 




TRA X253 






0614 


X26C 


AXT 1,4 


SET 1=1 




0615 


♦ NOW FORM XCAU) AND 


LOC(I) RECURSIVELY BY 




0616 


• 


LOCCI) = XCA(i-i) + 5 




0617 


» 


XCAU) » XCAU-1) ♦ 5 ♦ N(I) IF N(I) NOT =0 




0618 


* 


= XCAU-l) IF N(I) * 0 




0619 


* (LOOP 


TAKES ABOUT 25S HI SPEED INSTRUCTIONS) 




0620 


» SET LOCU) 






0621 


X28 


CLS ♦♦♦* 


♦♦=TABLE+1 PZE XCA( I-l),0,N( I- 


1) 


0622 




ADD K9 


K9=5 PZE LOC( I ),0,N( I- 


I) 


062 3 


X28A 


STA ♦♦♦* 


♦ ♦=TABL1 SET LOC( I ) = XCA( I-D+5 




0624 


♦NOW CHECK NU) 






0625 


X29 


CLA ♦♦♦* 


•♦=TABLE PZE 0,0, N(I) 




0626 




TNZ X30A 






0627 


• SET XCAU) FOR NU) 


* 0 




0628 


X32 


CAL ♦•♦* 


•♦=TABLE+1 MZE XCA( 1-1 ) ,0,N( I- 


1) 


0629 




ANA KMSK2 


MZE XCA( I-1),0,0 




0630 


X30 


SLW ♦♦#* 


♦ ♦- 1 ABLb = W£t AUAl i ii 




uo 3 i 




TRA X35 






0632 


♦ SET XCAU) FOR Ntl) 


NOT = 0 




0633 


X30A 


ARS 18 


PZE N(I),0,0 




0634 


X33B 


ADD ♦♦•^ 


♦♦=T ABL1 PZE LOC(I)+NU),0,N(I) 


0635 




SSM 


MZE XCAU), 0, NUT 




0636 


X31 


STO ♦♦♦* 


♦♦=T ABLE 




0637 


♦SET STORAGE ADDRESS 


IN XR2 FOR XCA,MPY,XCA,ADD,STO GROUP 




0638 




PAC 0,2 


-XCAU) IN XR2 




0639 


♦SET ADDRESS OF THE 


MPY INSTRUCTION IN THIS GROUP 




0640 




SXA T5,4 






0641 




CLA X62 






0642 




SUB T5 






0643 




STA K14 


PR0G1+S-I IN ADDR. OF K14 




0644 


♦NOW MOVE THE GROUP 


INTO POSITION IN OBJECT PROGRAM 




0645 


♦(NOTE 


THAT NO GROUP 


IS INSERTED FOR 1*0 BLOCK ) 




0646 




CLA Kll 


Kll^XCA 




0647 




STO 0,2 






0648 




STO 2,2 






0649 




CLA K14 


K14*MPY PR0G1+S-I 




0650 




STO 1,2 






0651 




CLA K12 


K12=ADD SUM 




0652 




STO 3,2 






0653 




CLA K13 


K13=? STO SUM 




0654 




STO 4,2 






0655 


♦CHECK 


COMPLETION 






0656 


X35 


TXI ♦+1,4 


,1 INCREASE I BY 1 




0657 


X36 


TXL X28,4 


,«♦ **-$ 




0658 


♦WHEN 1 


DONE FILL IN TRA 1,4 INSTRUCTION AND SET ENTRY ADDRESS 


0659 


X37 


LAC ••#4 


( •♦^T ABLE-S ) 




0660 




CLA K15 


K15=TRA 1,4 




0661 




STO 5,4 






0662 


X37A 


CLA ♦♦ 


•♦=TABL1-1 




0663 




STA T8 


ENTRY « LOC(l) 




0664 


♦MAIN ! 


LOOP, SCANS XtU AGAIN AND FILLS IN REMAINDER OF OBJECT PROGRAM 


0665 


♦(THIS 


LOOP TAKES 19N HI SPEED INSTRUCTIONS) 




0666 


♦ SET X 


INDEX I *1 






0667 


X40 


AXT 1,1 






0668 


♦GET NEXT X(I) VALUE 






0669 


X41 


CLA ♦♦,! 


(♦•=X+1) 




0670 


♦SET MAGN(X) IN XR4 


AND GET TABLE ENTRY (MAGN(X)) 




0671 




PAX 0,4 






0672 


X42 


CLA •• f 4 


•♦=TABLE 




0673 
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•SET FOR STORAGE OF NEXT INSTRUCTION OF OBJECT PROGRAM 
STA X51 
POX 0,2 

•IF TABLE ENTRY NEG, THIS IS FIRST X OF THIS MAGNITUDE 

TMI X46 
•IF POSITIVE WE WANT ADD OR SUB INSTRUCTION 



» FIRST REDUCE 

SUB 
X43 STO 
X44 CLA 

TMI 

»AOD 



DECR 
K7 

»»»4 
• ♦♦1 

X45 



OF TABLE, THEN CHECK SIGN OF X(I) 
K7=PZE0,0, 1 
{ •»=TABLE ) 

(»#=X+1) 



INSTRUCTION NEEDED 
CLA K17 
TRA X50 
•SUB INSTRUCTION NEEDED 
X45 CLA K19 
TRA X50 
•FOR FIRST X OF THIS MAGN WE 
•FIRST CHANGE SWITCH, REDUCE 
X46 SSP 

SUB K7 
X47 STO •*#4 
X48 CLA »«,1 
TMI X49 
•CLA INSTRUCTION NEEDED 
CLA K16 
TRA X50 
♦CLS INSTRUCTION NEEDED 
X49 CLA K18 
TRA X50 
•SUPPLY ADDRESS TO INSTRUCTION AND STORE IT 
•NOTE CLA, ADD, CLS, SUB, ARE ALL POSITIVE NUMBERS 



WANT CLA OR CLS INSTRUCTION 
DECR OF TABLE, THEN CHECK SIGN Of XtIS 

K7=PZE0,0,1 
(«»=TABLE) 
(♦»=X+1) 



X50 ADD T7 
X51 STO »»,2 
• INCREMENT UN+l-I, 
X52 CLA T7 
SUB Kl 
STO T7 
TXI 

X53 TXL X41,l,#» 
•END OF MAIN LOOP 



T7=N+1-I 
♦•=XCA(MAGN(X( I))) 
AND CHECK FOR FINISH 



(»»=N) 



•NOW FILL IN 
•(LOOP TAKES 
X60 
X61 
X62 



A XT 
PXA 
STO 
TXI 
X63 TXL 
•RESTORE INDEX 
X65 LXD 
LXD 
LXD 
CLA 
STO» 
TRA 



INTEGER TABLE IN PR0G1 TO PR0G1+S 
4(S+1) HI SPEED INSTRUCTIONS) 
0,4 



0,4 
♦ •*4 
•+1,4,1 
X61,4,#* 

REGISTERS, 

PROCOR-4,1 

PROCOR-3,2 

PROCOR-2,4 

T27 

6,4 

7,4 



(♦♦*PR0G1+S) 



(•♦=S) 
SET ERR, AND EXIT 



•CONSTANTS FOR PROCOR, FASCOR 
1 

10000 
500 
1.0 
2.0 
3.0 
0,0,1 
0,0,10000 
5 

0,0,2 

SUM 
SUM 



Kl 


PZE 


K2 


PZE 


K3 


PZE 


K4 


DEC 


K5 


DEC 


K6 


DEC 


K7 


PZE 


K8 


PZE 


K9 


PZE 


K10 


PZE 


Kli 


XCA 


K12 


ADD 


K13 


STO 


K14 


MPY 


K15 


TRA 


K16 


CLA 


K17 


ADD 


K18 


CLS 



{•♦=PR0G1+S-I) 



1,4 
0,1 
0,1 
0,1 



0674 
0675 
0676 
0677 
0678 
0679 
0680 
0681 
0682 
0683 
0684 
0685 
0686 
0687 
0688 
0689 
0690 
0691 
0692 
0693 
0694 
0695 
0696 
0697 
0698 
0699 
0700 
0701 
0702 
0703 
0704 
0705 
0706 
0707 
0708 
0709 
0710 
0711 
0712 
0713 
0714 
0715 
0716 
0717 
0718 
0719 
0720 
0721 
0722 
0723 
0724 
0725 
0726 
0727 
0728 
0729 
0730 
0731 
0732 
0733 
0734 
0735 
0736 
0737 
0738 
0739 
0740 
0741 
0742 
0743 
0744 
0745 
0746 
0747 
0748 
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K19 


SUB 




0,1 




0749 


K20 


OCT 




77777 




0750 


K21 


TRA 




0 




0751 


K22 


TRA 




#* 


( **=LOC(B)+N( B) ) 


0752 


K23 


OCT 




+050100000000 SEPARATES CLA FROM CLS 


0753 


K24 


OCT 




+040100000000 SEPARATES ADD FROM SUB 


0754 


K25 


AOD 




0,1 


-040000100000 


0755 


K26 


SUB 




0,1 


=040200100000 


0756 


K27 


CLA 




0,1 


=050000100000 


0757 


K28 


CLS 




0,1 


=050200100000 


0758 


K29 


DEC 




4.0 




0759 


K30 


PZE 




0,0,1000 




0760 


K31 


PZE 




10 




0761 


KMSK 


OCT 




77777 




0762 


KMSK2 


OCT 




400000077777 


0763 


•TEMPORARIES 






0764 


Tl 


PZE 




*# 


**=x 


0765 


T2 


PZE 




0,0,** 


**=N 


0766 


T3 


PZE 




0,0,** 


*»=s 


0767 


T4 


PZE 




*• 


**=PR0G1 


0768 


15 


PZE 




• * 


**=I DURING TABLE FORMING LOOP 


0769 


T6 


MZE 




## 


**=XCA(I~1) DURING DITTO 


0770 


T7 


PZE 




*» 


**=N+1-I FOR MAIN LOOP 1 INITIAL *N) 


0771 


T8 


PZE 




## 


**=ENTRY TO OBJECT PROGRAM FOR FASCOR = LGCfl) 


0772 


T9 


PZE 




»* 


**= TABLE = PROGl + S 


0773 


TIO 


PZE 




*» 


SPARE 


0774 


Til 


PZE 




*• 


*»=N FOR FASCOR 


0775 


T12 


PZE 




»♦ 


**=PR0G1+S+1 


0776 


T13 


PZE 




*♦ 


**=T ABL1 


0777 


T14 


PZE 




#* 


***T A8L2 


0778 


T15 


PZE 




*» 


**=TABL3 


0779 


T16 


PZE 




»* 


**=TABL4 


0780 


i i r 


H£C 




* * 


**=kkuG^-kkuG i 


076i 


T18 


PZE 




*• 


**=S+1 


0782 


T19 


PZE 




0,0,** 


***POSMAX 


0783 


T20 


PZE 




0,0, *« 


*#=MAGN OF NEGMAX 


0784 


T21 


PZE 






**=CORZER 


0785 


T22 


PZE 




»* 


» #= Y 


0786 


T23 


PZE 




• * 


♦*=Y-N 


0787 


T24 


PZE 




** 


**=LOC(I) DURING RESTORATION AFTER NEG LAGS 


0788 


T25 


PZE 




** 


**=N(I) DURING RESTORATION AFTER NEG LAGS 


0789 


T26 


PZE 




** 


**=MAGN OF NEGMAX 


0790 


T27 


PZE 




«* 


**= PROCOR ERR SETTING 


0791 


T28 


PZE 




** 


«»= N+10(S+1)+1 


0792 


T29 


PZE 




*» 


**= 0 (OK), = 1 (BYPASS) 


0793 


T30 


PZE 




♦ * 


**= FASCGR ERROR SETTING 


0794 


SUM 


PZE 




• * 


**=CROSS PRODUCTS SUM 


0795 


NXTXI 


PZE 




*» 


#»=N+l-I WHERE I=INDEX OF NEXT X TO DELETE 


0796 


• 








UNIT =1 (POS LAGS), * N (NEG LASSIT 


0797 


PNEWBT 


PZE 




** 


**=INSTR INDEX IN BLOCK NEWB FOR LAG T 


0798 


NEWINS 


NOP 






HOLDS INSTRUCTION TO BE SET ASIDE 


0799 


LOCNWB 


PZE 




»* 


••^ADDRESS OF NEW BLOCK = LOC(NEWB) 


0800 


NNEWB 


PZE 




♦ * 


**N VALUE OF NEW BLOCK = N(NEWB) 


0801 


LOCOtX 


PZE 




*» 


**= -( TABL2-L ASTB ) UNIT * -(TA8L2-S/2) 


0802 


LAG 


PZE 




** 


**=LAG T 


0803 


* 










0804 


* 










0805 


♦FORMAT OF 


FINAL OBJECT 


PROGRAM IS 


0806 


• 










0807 


•PROG1 


PZE 




s 




0808 


» 


PZE 




S-i 




0809 


» 


ETC 






0810 


* + S+1 


CLA 


OR 


CLS N+l- 


•**,1 ZEROTH THE ** ARE 


0811 


• 


AOD 


OR 


SUB N+l~**,l BLOCK FORTRAN CONVENTION 


0812 


• 


ETC 




(NOT ACTUALLY INDICES OF THE X(I) 


0813 


• 


ADD 


OR 


SUB N+l- 


OPERATED, BUT SERIES. THE FIRST 


0814 


» 


PZE 


0 




NEEDED FOR BLOCK CONTAINS ALL 


0815 


• 


PZE 


0 




SUBSTITUTION INDICES FOR WHICH 


0816 


• 


PZE 






LOGIC OF THE MAGNITUDE OF XU)*1 


0817 


• 


PZE 


0 




FASCOR) THE SECOND 8L0CK 


0818 


• 


PZE 


0 




ALL INDICES FOR WHICH 


0819 


*LOCU)CLA 


OR 


CLS N+l- 


•**,1 FIRST THE MAGNITUDE OF X(I)*2 


0820 


» 


ADD 


OR 


SUB N+l- 


■**,1 BLOCK ETC. THE SIGN OF 


0821 


• 


ETC 




(ENTER HERE) X(l) DETERMINES 


0822 


• 


ADD 


OR 


SUB N+l- 


**,1 WHETHER ADD (CLA) OR 


0823 
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« 


XCA 




SUB (CLS) IS USED. 


0824 


• 


mpy 


PROG1+S-1 


BLOCKS WILL BE MISSING 


0825 


» 


XCA 




IF THERE ARE NO X(I) 


0826 


» 


AOD 


SUM 


OF CORRESPONDING 


0827 


• 


STO 


SUM 


MAGNITUDE 


0828 


• 


ETC 




NOTE THAT THE 


0829 


• 


ETC 




TOTAL NUMBER OF 


0830 



»LOC(S)CLA 


OR 


CLS 


N*l-**,1 


LAST 


ADD, CLA, SUB, CLS 


0831 


* ADD 


OR 


SUB 


N*l-«»,1 


BLOCK 


INSTRNS OPERATED WILL 


0832 


• ETC 








BE LESS THAN N BY 


0833 


* ADD 


OR 


SUB 


N*l-**,1 




AN AMOUNT EQUAL TO 


0834 


* XCA 










THE NUMBER OF ZEROES 


0835 


» MPY 




PR0G1 




IN THE X SERIES. 


0836 


• XCA 












0837 


» ADD 




SUM 






FASCOR SETS XR1»-(Y-N)t 


0838 


* STO 




SUM 






Y IS SECOND SERIESt 


0839 


* TRA 




1,4 




EXIT 


BEFORE ENTRY* ANO 


0840 


* 










INCREMENTS XR1 FOR LAGS 


0841 



* HOWEVER EACH TIME FASCOR INCREMENTS FOR LAGS IT MUST DELETE AN 0842 

* INSTRUCTION IN THE OBJECT PROGRAM (BY INSERTING A TRA) TO 0843 
» PRODUCE THE TRANSIENT EFFECT. WHEN IT FINISHES IT MUST RESTORE 0844 

* THE OBJECT PROGRAM FOR REUSE ON ANOTHER CALL OF FASCOR. 0845 
» 0846 

* PROCOR SETS UP TWO TABLES, TABLE(I) AND TABLKI) AS BELOW 0847 
» (IT USES TABLE ( I ) ITSELF. TABL1 IS A SERVICE TO FASCOR) 0848 

* 0849 
» TABLE- I = MZE XCA ( I ) , 0, N( I ) I=0,1,...,S 0850 

* AND 0851 

* TABLl-I » PZE LOCU),0,N(I) I=0,1,...,S 0852 

* WHERE N(I) « NO. OF X VALUES HAVING MAGNITUDE I 0853 

* XCAU) * ADDRESS OF FIRST XCA INSTRUCTION IN BLOCK NOV I 0854 
« LOC(I) = ADDRESS OF FIRST INSTRUCTION IN BLOCK NO. I 0855 
» RELATIONS BETWEEN LOCU), XCAU), AND N(I) NEEDED BY PROCOR LOGIC ARE 0856 
« LOC(O) » PR0G1+S+1 0857 

* XCAIO) « LOC(0)+N(0) IF N(0) NOT » 0 0858 
» * LOC(O) - 5 IF N(0) = 0 0859 

* RECURSION FORMULA FOR LOC(I) 1 = 1,2, ...,S 0860 

* LOCU) = LOC( I-l)+NU-l)*5 IF N(I-l) NOT » 0 086L 

* » LCC(I-l) IF NU-1) * 0 0862 
» RECURSION FORMULA FOR XCA(I) 1=1,2, ...,S 0863 

* XCAU) » XCA( I-D+NU )+5 IF Nil) NOT * 0 0864 
» « XCAU-l) IF N(I) » 0 0865 

* IT CAN BE SHOWN BY INDUCTION THAT THE ABOVE LEADS TO 0866 

* LOCU) - XCAU-U+5 IN ALL CASES 0867 
» SO THAT 0868 

* XCAU) = LOC(I)+NU) IF NU) NOT = 0 0869 

* * LCCCI)-5 IF N(I) =0 0870 

* 0871 

* FASCOR USES TABL1 WITHOUT MODIFYING IT IN ANY WAY. FASCOR ALSO 0872 
« SETS UP THREE OTHER TABLES- TABL2, TABL3 AND TABL4. THESE TABLES 0873 
» ARE DESIGNED TO SPEED UP THE SUBSTITUTION LOGIC INVOLVED IN 0874 

* THE SUCCESSIVE REPLACEMENT OF INSTRUCTIONS BY TRANSFERS. 0875 
» 0876 

* DEFINITIONS INVOLVED IN TABLE DESCRIPTIONS 0877 

* 8 » AN ARBITRARY BLOCK NO. IN OBJECT PROGRAM 0878 

* AD ( Y) * ADDRESS PORTION OF INSTRUCTION AT LOCATION Y 0879 

* P(B,Y) = INDEX OF THE INSTRUCTION AT LOCATION Y RELATIVE TO 0880 

* BLOCK B WHERE P(8,L0C(B)) = I P(B,L0C(8H1) * 2 ETC 0881 
» OP(Y) * CONTENTS OF LOCATION Y 0882 

* NXT ( B ,T) * LOCATION, JUST BEFORE COMPUTATION AT LAG T, OF THE 0883 
« NEXT INSTRUCTION IN BLOCK B WHICH IS TO BE CONSIDERED 0884 

* FOR POSSIBLE SUBSTITUTION 0885 

* 0886 

* TABL2 - ADDRESS PORTIONS OF NEXT POSSIBLE INSTRUCTION TO SET ASIDE 0887 

* FROM BLOCK B 0888 

* THE FOLLOWING FACTS ARE NEEDED TO UNDERSTAND HOW TABL2 WORKS 0889 
« I. ADtY) IS MCNCTONE DECREASING FOR Y=LOC< B ),.*., LOC( B JN-N( B )-l 0890 

* 2. OP(Y) CORRESPONDS TO MONOTONE INCREASING X(I) INDICES 0891 

* FOR Y * L0C(B),...,L0C(B)+N(B)~1 0892 

* 3. THE VALUE OF AD(Y) MUST LIE BETWEEN 1 AND N INCLUSIVE 0893 

* FOR Y » L0C(B),...,L0C(B)+N(B)-1 0894 
» TABL2 MEANING JUST PRIOR TO SUBSTITUTION ANALYSIS FOR LAG T 0895 

* TABL2-B » PZE AO(NXT(B,T)) IF B STILL HAS UNDELETED ELEMENTS 0896 
» = OCT G00000077777 IF B HAS NO MORE DITTO (POS LAGS3 0897 

* « OCT 000000000000 IF B HAS NO MORE DITTO (NEG LAGS) 0898 
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• INITIAL SETTING OF TABL2 FOR POSITIVE LAGS 0899 
» TABL2-B = PZE AD( LOC( B ) *N{ B )-l ) IF N(B) NOT * 0 0900 

• * OCT C00000077777 IF NIB) = 0 (THIS IS BYPASS SWCN) 0901 
» INITIAL SETTING OF TABL2 FOR NEGATIVE LAGS 0902 

• TABL2-B « PZE AD(LOC(B)) IF N(B) NOT = 0 0903 

• = PZE 0 IF N( 8) » 0 ( BYPASS SWITCH) 0904 

• 0905 
» TABL3 - INDICES OF NEXT POSSIBLE INSTRUCTION TO SET ASIDE FROM BLOCK B 0906 
» MEANING JUST PRIOR TO SUBSTITUTION ANALYSIS FOR LAG T IS 0907 
» TABL3-B = PZE P I B , NXT ( B, T ) ) 0908 
» INITIAL SETTING OF TABL3 FOR POSITIVE LAGS 0909 

• TABL3-B = PZE N(B) 0910 

• INITIAL SETTING OF TABL3 FOR NEGATIVE LAGS 0911 

• TABL3-B = 1 0912 
» 0913 
» TABL4 - STORAGE FOR INSTRUCTION SET ASIDE FROM BLOCK B 0914 

• MEANING JUST PRIOR TO SUBSTITUTION ANALYSIS FOR LAG T IS 0915 

• TABL4-B * 0 IF NO INSTRUCTIONS HAVE BEEN TAKEN FROM BLOCK B YET 0916 
» » OP<NXT(B t T)+l) FOR POSITIVE LAGS 0917 

• * OP(LOC(B)) NEGATIVE LAGS 0918 
« INITIAL STTING OF TABL4 FOR POSITIVE OR NEGATIVE LAGS 0919 
» TABL4-B * PZE 0 0920 

• 0921 
HTR 0 0922 
HTR 0 0923 
HTR 0 0924 
BCI 1,FASC0R 0925 

FASCOR SXD FASCOR-4,1 0926 

SXD FASC0R-3t2 0927 

SXD FASCOR-2,4 0928 

♦CHECK FOR EXISTENCE OF OBECT PROGRAM. (NO IF N FROM PROCOR » 0 0929 

• OR IF ERR FROM PROCOR IS NOT ZERO) 0930 

CLA K^r IV,- 1.0 5 n .P.G D . SET 09^1 

STO T30 0932 

CLA T2 N CHECK 0933 

TMI Y96 0934 

TZE Y96 0935 

CLA T27 ERR CHECK 0936 

TNZ Y96 0937 

•NOW CHECK LEGALITIES OF POSMAX, NEGMAX 0938 

CLA K5 K5= 2.0 ERROR SET 0939 

STO T30 0940 

CLA» 3,4 POSMAX CHECK 0941 

TZE «+2 0942 

TMI Y96 0943 

CAS T2 0944 

NOP 0945 

•(NEXT INSTRUCTION - NOP FOR FASEPC OR FASEP1) 0946 

Y2 TRA Y96 CANT * N 0947 

STD T19 0948 

CLS* 2t4 NEGMAX CHECK 0949 

TZE ♦♦2 0950 

TMI Y96 0951 

CAS T2 0952 

NOP 0953 

•(NEXT INSTRUCTION * NOP FOR FASEPC OR FASEP1) 0954 

Y3 TRA Y96 0955 

STD T20 0956 

♦SET OUTPUT CLEAR ROUTINE AND CHECK FOR BYPASS ON X(I) ALL ZERO 0957 

ADD T19 0958 

ADD K7 POSMAX+MAGN( NEGMAX )*1 0959 

STD Y95B 0960 

CLA T20 0961 

ARS 18 0962 

ADD Kl 0963 

ACL 4,4 CORZER+MAGNC NEGMAX )+l 0964 

STA Y95A 0965 

CLA T29 BYPASS SWITCH 0966 

•(NEXT INSTRUCTION « TNZ Y95C FOR FASCR1, FASEP1) 0967 

Y4 TNZ Y95 0968 

•TURN OFF OVERFLOW AND SET ERRORS FOR POSSIBLE OVERFLOW 0969 

» (OBJECT PROGRAM IS NOT RESTORED IN THIS CASE) 0970 

TOV ♦+! 0971 

CLA K6 K6= 3.0 0972 

STO T27 (SO THAT PROCOR MUST BE USED AGAIN IF OVERFLOW) 0973 
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STO 


T30 


0974 


♦ SET 


ENTRIES TO OBJECT PROGRAM, CORZER ADDRESSES, Y, Y-N 


0975 




CLA 


T8 


0976 




STA 


Y6 


0977 




STA 


Y25 


0978 




STA 


Y81 


0979 




CLA 


4,4 


0980 




STA 


Y7 


0981 




STA 


Y26 


0982 




STA 


Y82 


0983 




STA 


T21 


0984 




CLA 


1,4 


0985 




STA 


T22 


0986 




SSP 




0987 




SUB 


Til 


0988 




STA 


T23 


0989 


• NOW 


COMPUTE ZERO LAG CORRELATION AND STORE IT 


0990 




PAC 


0,1 -(Y-N) TO IR1 


0991 




STZ 


SUM 


0992 


Y6 


TSX 


♦♦,4 ♦♦-ENTRY TO OBJECT PROGRAM 


0993 




CLA 


SUM 


0994 


* ( NEXT INSTRUCTION * ADD CORZER FOR FASCR1 OR FASEP1) 


0995 




NOP 




0996 


Y7 


STO 


♦♦ ♦♦=CORZER 


0997 




TOV 


Y96 


0998 


♦ SET 


DECREMENTS S 


0999 




CLA 


T3 


1000 




STD 


Y8G 


1001 




STD 


Y33 


1002 




STD 


Y43 


1003 




STD 


Y94 


1004 


♦ SET 


TABL1 


ADDRESSES BELCW 


1005 




CLA 


T13 


1006 




STA 


Y8A 


1007 




STA 


Y20 


1008 




STA 


Y29 


1009 




STA 


Y38 


1010 




STA 


Y60 


1011 




STA 


Y86 


1012 


♦ SET 


TABL2 


ADDRESSES BELOW 


1013 




CLA 


T14 


1014 




STA 


Y8D 


1015 




STA 


Y21B 


1016 




STA 


Y23A 


1017 




STA 


Y40 


1018 




STA 


Y72 


1019 




STA 


Y78 


1020 




ADD 


Kl TABL2+1 


1021 




ALS 


18 IN OECR 


1022 




PDC 


0,2 


1023 




SXD 


Y10,2 ~( TABL2+ 1 ) STORED 


1024 




SXD 


Y50,2 


1025 




SUB 


T3 TABL2+1-S 


1026 




SUB 


K7 


1027 




PDC 


0,2 


1028 




SXD 


Yll,2 -( TABL2-S ) STORED 


1029 




SXD 


Y51,2 


1030 


♦ SET 


TABL3 


ADDRESSES BELOW 


1031 




CLA 


T15 


1032 




STA 


Y8E 


1033 




STA 


Y20A 


1034 




STA 


Y21C 


1035 




STA 


Y21D 


1036 




STA 


Y30 


1037 




STA 


Y42 


1038 




STA 


Y61 


1039 




STA 


Y73 


1040 




STA 


Y74 


1041 


♦ SET 


TABL4 


ADDRESSES BELOW 


1042 




CLA 


T16 


1043 




STA 


Y8F 


1044 




STA 


Y208 


1045 




STA 


Y21A 


1046 




STA 


Y28 


1047 




STA 


Y31 


1048 
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STA 


Y41 




1049 


STA 


Y76 




1050 


STA 


Y85 




1051 


STA 


Y87 




1052 


♦SET DECREMENTS OEPENDING 


ON POSMAX,NEGMAX BELOW 


1053 


CLA 


T19 


POSMAX IN DECR 


1054 


STD 


Y27 




1055 


CLA 


T20 


MAGN OF NEGMAX IN DECR 


1056 


ARS 


18 




1057 


STA 


T26 




1058 


♦ARE POSITIVE 


LAGS WANTED 




1059 


CLA 


T19 


GET POSMAX 


106C 


CAS 


K7 




1061 


TRA 


Y8 


YES 


1062 


TRA 


Y8 


YES 


1063 


TRA 


Y35 


NO 


1064 


m_ AJ A ft/ T Ikl T T f A 1 

♦MAKE INITIAL 


SETTINGS FOR 


POSITIVE LAGS 


1065 


Y8 CLA 


Kl 




1066 


STO 


NXTXI 


NXTXI^l 


1067 


STO 


LAG 


T=l 


1068 


CLA 


T3 


S 


1069 


ARS 


19 


S/2 IN ADDRESS 


1070 


SSM 




-S/2 


1071 


ADO 


T14 


PLUS TABL2 


1072 


PAC 


Of 1 




1073 


SXA 


LOCCLX,! 




1074 


„ f"" T | in "V* A 0 ft 

♦SET UP TABL2 


,TA8L3, AND TABL4 FOR POSITIVE LAGS 


1075 


♦(LOOP TAKES 


15(S*1) HI SPEED INSTRUCTIONS) 


1076 


AXT 


0,1 


1=0 


1077 


Y8A CLA 


♦ ♦•I 


(♦♦=TABL1) 


1078 


PDC 


0,2 


-N(I) TO XR2 


1079 


TXH 


Y8B,2,0 




1080 


tAL 




K 20* OCT 7 777 7 


1CG1 


TRA 


Y80 


SET THIS CONSTANT FOR N(I)*0 


1082 


Y8B SUB 


Kl 




1083 


STA 


♦ ♦1 




1084 


Y8C CAL 


** f 2 ♦♦ 


=LOC( I)-i 


1085 


ANA 


K20 


EXTRACT AD(LOC( I )+N( I )-l) 


1086 


Y8D SLW 


** f l «« 


-TABL2 


1087 


PXA 


0,2 




1088 


PAC 


0,2 




1089 


PXA 


0,2 




1090 


Y8E STO 


♦♦#1 


(**=TABL3) STORE N( I) 


1091 


Y8F STZ 


♦ »,1 


(♦*=TABL4) CLEAR 


1092 


TXI 


♦+1,1,1 




1093 


Y8G TXL 


Y8Atlt*^ 


(♦♦=S) 


1094 


♦NOW LOOP THRU ALL POSITIVE LAGS 


1095 


♦THIS LOOP SCANS THE INDICES IN TABL2 TO FIND NEWB, I.E., 


1096 


♦TO FIND FROM 


WHICH BLOCK 


THE NEXT INSTRUCTION IS TO BE DELETED^ 


1097 


♦IT STARTS SCANNING FROM INSIDE TABL2 AT THE SAME BLOCK AS THAT 


1098 


♦OF THE PREVIOUS DELETION 


AND PROCEEDS OUTWARDS IN BOTH DIRECTIONS 


1099 


♦TO MINIMIZE 


NUMBER OF TRIAL COMPARISONS 


1100 


♦(LOOP Y9 TO 


Y22 TAKES ABOUT POSMAXM 53+( 3 TO 3MS + 1))) HI SPEED 


1101 


♦ INSTRUCTIONS EXCLUSIVE 


OF OBJECT PROGRAM) 


1 102 


♦(NEXT INSTRUCTION = TRA 


Y24 FOR FASEPC OR FASEPl) 


1103 


Y9 LXA 


L0C0LX,1 


SET TO EXAMINE NEXT INDEX 


1104 


LXA 


L0C0LX,2 


IN OLD BLOCK FIRST 


1105 


CLA 


NXTXI 


GET INDEX TO COMPARE 


1106 


♦SCAN DOWNWARDS 




1107 


YIO TXL 


Yll,l,#^ 


( ♦#=-( TABL2+1 ) ) AVOID OVERSHOOT 


1108 


CAS 


0,1 




1109 


HPR 


* 


IMPOSSIBLE 


1 110 


TRA 


Y13 


GOT IT 


1111 


TXI 


♦♦1,1,-1 




1112 


♦AND UPWARDS 






1113 


Yll TXH 


Y10,2,#* 


***-(TABL2-S) AVOID UNDERSHOOT 


1114 


CAS 


0,2 




1115 


HPR 


* 


IMPOSSIBLE 


1116 


TRA 


Y12 




1117 


TXI 


YIO, 2,1 




1118 


♦WHEN INDEX FOUND REPLACE 


THE OLC BLOCK ADDRESS BY NEW ONE 


1119 


♦FIND NEWB AND SET XRl TO 


NEWB 


1120 


Y12 SXA 


L0C0LX,2 




1121 


TRA 


Y14 




1122 


Y13 SXA 


LOCOLX,! 




1123 
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Y14 LAC 


LOCOLX,l 




1124 


PXA 


0,1 


TABL2-NEWB IN AC NOW 


1125 


SUB 


T14 


T14*PZE TABL2 


1126 


SSP 




NEWB IN AC 


1127 


PAX 


0,1 


SET XR1 FOR FUTURE LOOK-UPS 


1128 


♦GET LOC(NEWB) AND N(NEWB) 




1129 


Y20 CLA 


♦ ♦,1 


(♦♦=TABLl) 


1130 


STA 


L0CNW8 




1131 


ARS 


18 




1132 


STA 


NNEWB 




1133 


♦GET P(NEWB,NXT(NEWB,I)) AND 


THE NEW INSTRUCTION TO BE REPLACf D 


1134 


Y20A CLA 


♦♦,1 


( ♦♦=TABL 3) 


1135 


STA 


PNEWBT 




1136 


ADD 


LOCNWB 




1137 


SUB 


Kl 




1138 


PAC 


0,2 


- ( ADDRESS OF INSTR TO DELETE! 


1139 


CLA 


0,2 




1140 


STO 


NEWINS 




1141 


♦CHECK, IS THIS FIRST REPLACEMENT IN THIS BLOCK 


1142 


CLA 


PNEWBT 




1143 


CAS 


NNEWB 




1144 


HPR 


• 


IMPOSSIBLE 


1145 


TRA 


Y22 


YES 


1146 


♦IF NOT, MOVE TRA INSTRUCTION UP ONE NOTCH, AND RESTORE OLD INSTRUCTION 


1147 


CLA 


1.2 


MOVE UP 


1148 


STO 


0,2 


TRA 


1149 


Y20B CLA 


♦ ♦, 1 


(«»=TABL4) RESTORE OLD 


1150 


STO 


1,2 


INSTRUCTION 


1151 


♦THEN SAVE 


NEW INSTRUCTION AND CHECK IF TRA IS NOW AT TOP OF SLOCK 


1152 


Y21 CLA 


NEW INS 




1153 


Y21A STO 


♦♦,1 


(♦♦=TABL4) 


1154 


CLA 


Ki 


(Kl=l) 


1155 


CAS 


PNEWBT 




1156 


HPR 


* 


IMPOSSIBLE 


1157 


TRA 


Y23 


YES, SINCE P ( NEWB, NXT( NEWB »T> ) = 1 


1158 


♦IF NOT AT 


TOP SET NEW X INDEX TO BE CHECKED ( FROM BLOCK NEWB) INTO TABL2 


1159 


CLA 


-lt2 




1160 


Y21B STA 


♦♦,1 


( ♦♦=TABL2 ) 


1161 


♦REDUCE INSTRUCTION INDEX FOR BLOCK NEWB IN TABL3 


1162 


Y21C CLA 


♦♦,1 


(♦♦=TABL3) 


1163 


SUB 


Kl 




1164 


Y21D STO 


♦ ♦#1 


(♦♦=TABL3) 


1165 


TRA 


Y24 


ON TO COMPUTE CORRELATION 


1166 


♦FOR FIRST 


REPLACEMENT FORM 


TRA LOC (NEW B)+N (NEWB) AND 


1167 


♦INSERT IN 


LOC(NEWB)+N(NEWB) 


-1 


1168 


Y22 CLA 


LOCNWB 




1169 


ADD 


NNEWB 




1170 


STA 


K22 


K22=TRA ♦♦ 


1171 


CLA 


K22 




1172 


STO 


0,2 




1173 


TRA 


Y21 


BACK TO SAVE INSTRUCTION 


1174 


♦IF TRA AT 


TOP OF BLOCK ADD 


5 TO ITS ADDRESS AND SET 


1175 


♦TABL2 SO THIS BLOCK IS INVISIBLE TO FUTURE SCANS 


1176 


Y23 CLA 


0,2 




1177 


ADD 


K9 


K9=5 


1178 


STA 


0,2 




1179 


CLA 


K20 


K20=77777 


1180 


Y23A STO 


♦ ♦t 1 


(♦♦*TABL2) 


1181 


TRA 


Y21C 


BACK TO UPDATE TABL3 FOR LAST TIME 


1182 


♦NOW COMPUTE CORRELATION 




1183 


Y24 CLS 


LAG 


-T SET FOR 


1184 


PAX 


0,2 


T IN IR2 STORAGE 


1185 


ADD 


T23 


Y-N-T 


1186 


PAC 


0,1 


- ( Y-N-T ) TO IR1 


1187 


TPL 


♦+2 




1188 


PAX 


0,1 


{ FOR CASE Y-N-T NEGATIVE) 


1189 


STZ 


SUM 




1190 


Y25 TSX 


♦ ♦,4 


(♦♦^ENTRY POINT TO OBJECT PROGRAM) 


1191 


CLA 


SUM 




1192 


♦(NEXT INSTRUCTION = ADD COR2ER,2 FOR FASCRi, FASEP1) 


1193 


NOP 






1194 


Y26 STO 


♦ ♦♦2 


(♦♦^CORZER) 


1195 


TOV 


Y96 


ERROR EXIT 


1196 


CLA 


NXTXI 




1197 


ADD 


Kl 




1198 
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STO 


NXTXI 










1 199 




TXI 


♦+1»2,1 










1200 




SXA 


LAG, 2 










Levi i. 


« C 1 


TXL 


Y9,2,^ 


( ♦♦sPOSMAX) 








1202 


» WMFN 
» Bnun 


DONE, RESTORE INSTRUCTIONS WHICH HAVE BEEN 


REPLACED 


BY TRA 




* ( LOOP 


TAKES 


ABOUT 24MS+1) 


HI SPEED INSTRUCTIONS) 




1204 


♦ i NEXT 


INSTRUCTION « TRA 


Y35 FOR FASEPC OR 


FASEP1) 








AXT 


n - 1 

U, l 


1=0 








1206 


Y28 


CLA 


** * l 


<*»=TABL4) 








1207 




TZE 




ZERO MEANS NO REPLACEMENT IN 


BLOCK 


1208 


Y29 


CLA 


** f I 


(♦♦=TABL1) 








1 OftQ 

X tU7 


Y30 


ADD 


♦♦ , I 


( »»=T ABL3 ) 








lain 




PAC 


n 9 


-(LOC( I)+P(I,LAST 


SUBS)-1) 




1 91 1 


Y31 


CLA 


*« * 1 


(**=TABL4) 








171 7 
1 C 1 c. 




STO 


U, c 


RESTORE INSTRUCTION 






l£i J 


Y32 


TXI 


m.*. 1 1-1 
*♦ If If 1 










1 C JL *r 


Y33 


TXL 


V9« 1 * m. 


(♦♦=S) 








1215 


♦ARE NEGATIVE 


LAO J WANItU 










1216 


Y35 


CLA 


T20 










1717 




CAS 


K7 










lclO 




TRA 


Y36 


YES 








1219 




TRA 


Y36 


YES 








i *> o n 




TRA 


Y95C 


NO-GO EXIT 










♦MAKE 


INITIAL 


SETTINGS FOR 


NEGATIVE LAGS 








1222 


Y36 


CLA 


Til 










1223 




STO 


NXTXI 










1224 




CLA 


Kl 










1 CC J 




STO 


LAG 










1 226 




CLA 


T3 


S 








1227 




ARS 


19 


S/2 








1228 




SSM 




-S/2 








1229 




ADD 


T14 


PLUS TABL2 








1230 




r AC 












1 o%\ 




SXA 


LOCOLX#l 










1232 


♦SET UP TABL2 


, TABL3» TABL4 


FOR NEG LAGS 








1233 


♦ (LOOP 


TAKES 


12MS+1) HI SPEED INSTRUCTIONS) 








1234 


Y37 


AXT 


0,1 


I = 0 








1235 


Y38 


CLA 


♦♦•1 


(•» * TABL1) 








1236 




PDX 


0,2 


-N< I) TO XR2 








1 237 




TXH 


Y39,2,0 










1238 




CLM 












1239 




TRA 


Y40 










1240 


Y39 


PAC 


0,2 














CAL 


0,2 










1 242 




ANA 


K20 


K20 * 77777 








1243 


Y40 


SLW 


** f l 


TABL2 








1 244 


Y41 


STZ 


♦ ♦#1 


(♦♦ « TABL4) 








1 245 




CLA 


Kl 










1246 


Y42 


STO 


♦♦,1 


(*• s TABL3 ) 








1247 




TXI 


♦♦1,1,1 










1248 


Y43 


TXL 


Y38,l,#^ 


(♦♦ = S) 








1 7&Q 

1 c.*rrf 


♦NOW LOOP THROUGH CORRELATIONS 








1250 


♦ THIS 


LOOP SCANS TA8L2 AS DOES LOOP AT Y9, BUT 






1251 


♦ DOES 


IT FOR 


NEGATIVE LAGS 


(INEQUALITIES WORK 


OPPOSITELY) 




1252 


♦(LOOP 


Y49 TO 


Y84-1 TAKES ABOUT NEGMAX»( 6 !♦( 3 


TO 




HI SPEED 


1253 


♦ INSTRUCTIONS EXCLUSIVE 


OF OBJECT PROGRAM) 








1254 


♦(NEXT 


INSTRUCTION = TRA 


Y80 FOR FASEPC OR 


FASEP1) 




1255 


Y49 


LXA 


LOCOLXU 










1256 




LXA 


L0C0LX#2 










1257 




CLA 


NXTXI 










1258 


Y50 


TXL 


Y51,l,#» 


(♦♦=-(TABL2+l)) 








1259 




CAS 


0,1 










1260 




TXI 


Y51,l,~l 


NO GOOD 








1261 




TRA 


Y53 


GOT IT 








1262 




HPR 


* 


IMPOSSIBLE 








1263 


Y51 


TXH 


Y50,2,#^ 


»♦= — (TABL2-S) 








1264 




CAS 


0,2 










1265 




TXI 


Y50,2,l 


NO GOOD 








1266 




TRA 


Y52 


GOT IT 








1267 




HPR 


• 


IMPOSSIBLE 








1268 


Y52 


SXA 


L0C0LX,2 










1269 




TRA 


Y54 










1270 


Y53 


SXA 


LOCOLXU 










1271 


Y54 


LAC 


L0C0LX,1 










1272 




PXA 


0,1 










1273 



• •••••••••«••»«•«•*••»** PROGRAM LISTINGS tli*M»*»«itl»*itHi#« 

» PROCOR ♦ « PROCOR * 

••**••••«****•*•»••*•**» #****••»***••**•***•»•*• 
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SUB T14 T14 » PZE TABL2 1274 

SSP 1275 

PAX 0,1 NEWS IN XR1 1276 

•GET LOC(NEWB) AND N(NEWB) 1277 

Y60 CLA (♦♦ » TABL1) 1278 

STA LOCNWB 1279 

PAC 0,4 -LOC(NEWB) TO XR4 1280 

ARS 18 1281 

STA NNEWB 1282 

• GET P(NEWB,NXT(NEWB,T) ) 1283 

Y61 CLA **tl (♦♦ = TABL3) 1284 

STA PNEWBT 1285 

ADD LOCNWB 1286 

SUB Kl 1287 

PAC 0,2 -(LOC(NEWB) ♦ P(NEWBIT) - 1) TO XR2 1288 

•IS THIS THE FIRST REPLACEMENT OF BLOCK 1289 

CLA Kl 1290 

CAS PNEWBT 1291 

HPR « IMPOSSIBLE 1292 

TRA Y75 YES 1293 

•IF NOT, ADD 1 TO ADDRESS OF TRA INSTRUCTION 1294 

Y62 CLA 0,4 1295 

ADD Kl 1296 

STO 0,4 1297 

•WAS OLD MODIFIED INSTRUCTION CLA (0500) OR CLS (0502) 1298 

Y63 CLA 0,2 1299 

CAS K23 K23 * 0501 1300 

TRA Y65 IT IS CLS 1301 

HPR ♦ 1302 

•IF IT WAS CLA RECONVERT TO ADD 1303 

Y64 ANA K20 1304 

ADD K25 K25 » ADO 0,1 1305 

TRA Y66 1306 

•IF IT WAS CLS RECONVERT TO SUB 1307 

Y65 ANA K20 1308 

ADD K26 K26 * SUB 0,1 1309 

Y66 STO 0,2 1310 

♦IS THIS LAST INSTRUCTION IN BLOCK TO BE DELETED 1311 

Y67 CLA PNEWBT 1312 

CAS NNEWB 1313 

HPR ♦ IMPOSSIBLE 1314 

TRA Y77 YES 1315 

•IF NOT, CONVERT THE ADD (0400) OR SUB (0402) TO CLA OR CLS 1316 

Y68 CLA 1,2 1317 

CAS K24 K24 * 0401 1318 

TRA Y70 IT WAS SUB 1319 

HPR • IMPOSSIBLE 1320 

♦IF IT WAS ADD, CONVERT TO CLA 1321 

Y69 ANA K20 1322 

ADD K27 K27 = CLA 0,1 1323 

TRA Y71 GO ADJUST TABL2 1324 

♦IF IT WAS SUB, CONVERT TO CLS 1325 

Y70 ANA K20 1326 

ADD K28 K28 = CLS 0, i 1327 

Y71 STO 1,2 1328 

♦SET NEW X INDEX 1329 

Y72 STA (♦♦ = TABL2) 1330 

♦INCREASE TRIAL INSTRUCTION INDEX BY 1 IN TA8L3 1331 

Y73 CLA »*4l (•* = TABL3 ) 1332 

ADD Kl 1333 

Y74 STO •»,! (*• * TABL3) 1334 

TRA Y80 1335 

•IF FIRST REPLACEMENT, SAVE INSTRUCTION, FORM AND INSERT 1336 

•TRA LOC(NEWB) + 1 INTO LOC(NEWB) 1337 

Y75 CLA 0,4 1338 

Y76 STO »♦,! (*♦ = TA8L4) 1339 

CLA LOCNWB 1340 

ADD Kl 1341 

ADD K21 K21 » TRA 0 1342 

STO 0,4 1343 

TRA Y67 BACK TO CHECK IF IT IS LAST INSTRUCTION ALSO 1344 

•IF LAST REPLACEMENT, ADD 5 TO TRA INSTR ADDR AND SET 1345 

♦TABL2 TO MAKE THIS BLOCK INVISI8LE TO FURTHER SCANNING 1346 

Y77 CLA 0,4 1347 

ADD K9 K9 * 5 1348 



••»**•«•*»•••••*»«*•**•* 
» PROCOR * 
•••••••*•»*••«••»••*•»** 
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STO 0,4 
Y78 STZ **,1 
TRA Y73 
•NOW COMPUTE CORRELATION 



PROGRAM LISTINGS 



{** » TA8L2) 

BACK FOR ADJUSTMENT OF TABL3 



Y80 



LAG 
0,2 
T23 
0,1 
SUM 
•*,4 
SUM 



CLA 
PAC 
ADO 
PAC 
STZ 
Y81 TSX 
CLA 

•(NEXT INSTRUCTION 
NOP 
Y82 STO 
TOV 
CLA 
SUB 
STO 
CLA 
ADD 
STO 
CAS 
TRA 
TRA 
TRA 



T 

-T IN 
Y-N+T 
-(Y-N+T) TO XRl 



IR2 



SET FOR 
STORAGE 



( Y-N+T IS ALWAYS POSITIVE) 



(♦» * ENTRY POINT TO OBJECT PROGRAM} 
ADD C0RZER,2 FOR FASCR1, FASEP1) 



*»t2 

Y96 
NXTXI 
Kl 

NXTXI 
LAG 
Kl 
LAG 
T26 
Y84 
Y49 
Y49 



CORZER) 



GO WINDUP 
GO BACK 
GO BACK 



•WHEN DONE, RESTORE INSTRUCTIONS WHICH HAVE BEEN REPLACED 
•BY TRA AND RECONVERT TO ADD OR SUB ANY OTHER 
•INSTRUCTIONS WHICH HAVE BEEN CHANGED AND NOT RECHANGED 
• (LOOP TAKES ABOUT 24#(S+1) HI SPEED INSTRUCTIONS) 
•(NEXT INSTRUCTION * TRA Y95C FOR FASEPC OR FASEP1) 



(** = TABL4) 

I Gniur\c IF Z c r\G 

(•* » TABL1) 
-(LOC(I)) TO IR2 
SAVE LOC(I) 
AND N( I) 

GET TRA INSTRUCTION FROM BLOCK I 
(•• * TABL4) REPLACE BY 

OLD INSTRUCTION 
EXTRACT ADDRESS OF TRA 
ADDRESS MINUS LOC( I) 
COMPARE WITH N( I) 
BIGGER, SO MUST BE TRA LOCU + 1) 
IMPOSSIBLE 
i/ERTED. IS IT CLA OR CLS 



Y84 


AXT 




0,1 


Y85 


CLA 




**i 1 




1 ctz 




Y9-3 


Y86 


CLA 




•♦, 1 




PAC 




0,2 




STA 




T24 




ARS 




18 




STA 




T25 




CLA 




0,2 


Y87 


LDQ 




••♦1 




STQ 




0,2 




ANA 




K20 




SUB 




T24 




CAS 




T25 




TRA 




Y93 




HPR 




» 


•GET INSTRUCTION TO 




ADD 




T24 


Y89 


STA 




Y90 




STA 




Y92 


Y90 


CLA 




#* 




CAS 




K23 




TRA 




Y91 




HPR 




• 


•IF CLA, CHANGE TO , 




ANA 




K20 




ADD 




K25 




TRA 




Y92 


•IF CLS, CHANGE TO : 


Y91 


ANA 




K20 




ADD 




K26 


•RESTORE 






Y92 


STO 




** 


•CHECK 


END 


OF 


LOOP 


Y93 


TXI 




•♦It 


Y94 


TXL 




Y85, 




TRA 




Y95C 


•CLEAR 


OUTPUT 


WHEN 1 


•(NOT i 


USED 


BY 


FASCR 


Y95 


AXT 




1»* 


Y95A 


STZ 




♦ »,4 




TXI 




♦♦1 


Y95B 


TXL 




Y95A 


•GENERAL EXIT 


FOR Al 


Y95C 


STZ 




T30 



SET FOR RESTORAGE 

(••^ADDRESS OF INSTR BEING RECONVERTED) 
IT IS CLS 



SUB 



4,1 



ADDRESS OF INSTR BEING RECSNVfRTED) 



(♦* » S) 

GO EXIT 
SNALS ALL 



XII) 



AND EXIT 



♦♦=CORZER+MAGNITUDE( NEGMAX )♦! 



*»=P0SMAX+MAGNITUDE(NEGMAX)+1 



OK 



#•»**#•••**•*» *•*«•*» 
# PROCOR • 
*»*•••**•••«*«•*•*•**•** 
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1349 
1350 
1351 
1352 
1353 
1354 
1355 
1356 
1357 
1358 
1359 
1360 
1361 
1362 
1363 
1364 
1365 
1366 
1367 
1368 
1369 
1370 
1371 
1372 
1373 
1374 
1375 
1376 
1377 
1378 
1379 
1380 

X J O 1 

1382 
1383 
1384 
1385 
)386 
1387 
1388 
1389 
1390 
1391 
1392 
1393 
1394 
1395 
1396 
1397 
1398 
1399 
1400 
1401 
1402 
1403 
1404 
1405 
1406 
1407 
1408 
1409 
1410 
1411 
1412 
1413 
1414 
1415 
1416 
1417 
1418 
1419 
1420 
1421 
1422 
1423 



*»•*•«••»**»»*•*•*»***** PROGRAM 
* PROCOR • 
••**•**••*•#*«•*»*••**#• 
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L ISTINGS #»##*#*#»#*♦*#•**♦**»#*« 
# PROCOR « 
**«**•••*•••*«»•*••*•*•» 
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STZ 




T27 


1424 


•RESTORE XRS 


AND SET ERROR 


1425 


Y96 LXD 




FASC0R~4,l 


1426 


LXO 




FASC0R~3,2 


1427 


LXD 




FASCOR-2,4 


1428 


CLA 




T30 


1429 


STO« 




5,4 


1430 


•NOW RESTORE 


FASCOR PROGRAM AND EXIT 


1431 


CLA 




K50A 


1432 


STO 




Y2 


1433 


STO 




Y3 


1434 


CLA 




K5IA 


1435 


STO 




Y9 


1436 


STO 




Y49 


1437 


CLA 




K52A 


1438 


STO 




Y28-1 


1439 


STO 




Y84 


1440 


CLA 




K64A 


1441 


STO 




Y4 


1442 


CLA 




K62A 


1443 


STO 




Y7-1 


1444 


STO 




Y26-1 


1445 


STO 




Y82-1 


1446 


TRA 




6,4 


1447 


* 






1448 


• 






1449 


•FASEPC, FASCR1, FASEP1 SUBSTITUTION CONSTANTS 


1450 


•(SERIES A FOR 


FASCOR* SERIES B FOR FASEPC) 


1451 


K50A TRA 




Y96 FOR Y2 AND Y3 


1452 


K50B NOP 




FOR Y2 AND Y3 


1453 


K51A LXA 




LOCOLX,! FOR Y9 AND Y49 


1454 


K51B TRA 




Y24 FOR Y9 


1455 


K52A AXT 




0,1 FOR Y28-1 AND Y84 


1456 


K52B TRA 




Y35 FOR Y28-1 


1457 


K53B TRA 




Y80 FOR Y49 


1458 


K54B TRA 




Y95C FOR Y84 


1459 


K60 ADO 




♦* »*-CORZER 


1460 


K61 PZE 




0,2,0 


1461 


K62A NOP 




FOR Y7-UY26-1, Y82-1 


1462 


K63 TNZ 




Y95C FOR Y4 


1463 


K64A TNZ 




Y95 FOR Y4 


1464 


• 






1465 


•MODIFY FASCOR 


TO BYPASS SUBSTITUTION LOGIC AND TO ELIMINATE 


1466 


• MAXIMUM 


LAG LIMIT CHECK 


1467 


FASEPC CLA 




K50B 


1468 


STO 




Y2 


1469 


STO 




Y3 


1470 


CLA 




K516 


1471 


STO 




Y9 


1472 


CLA 




K52B 


1473 


STO 




Y28-1 


1474 


CLA 




K53B 


1475 


STO 




Y49 


1476 


CLA 




K54B 


1477 


STO 




Y84 


1478 


TRA 




FASCOR 


1479 


• 






1480 


•MODIFY FASCOR 


SO CORRELATIONS ADD TO CORZERU) 


1481 


FASCR1 LOQ 




Kl Kl IS POSITIVE 


1482 


CLA 




4,4 


1483 


STA 




K60 K60= ADD *« 


1484 


CLA 




K60 


1485 


STO 




Y7-1 


1486 


ADD 




K61 K61 = PZE 0,2,0 


1487 


STO 




Y26-1 


1488 


STO 




Y82-1 


1489 


CLA 




K63 


1490 


STO 




Y4 


1491 


TQP 




FASCOR 


1492 


TRA 




FASEPC 


1493 


# 






1494 


•SAME AS FASCR1 BUT FOR FASEPC 


1495 


FASEP1 LDQ 




KMSK2 KMSK2 IS NEGATIVE 


1496 


TRA 




FASCR1+1 


1497 


END 






1498 



•*»*••*•***«••**»••*•*«* PROGRAM LISTINGS 

• PSQRT » * PSQRT » 

•*•••«•*••**«•••»••*»•*• *•«***•«*»••«•«*•«»«*»•* 



PSQRT (SUBROUTINE) 
LABEL 

r 

SUBROUTINE PSQRT ( N,C» M, A) 

-* — ABSTRACT- — - 



10/5/64 LAST CARD IN OECK IS NO. 



CPSQRT 

C 
C 

c 

C TITLE - PSQRT 
C 
C 
C 
C 



FIND THE POWER SERIES SQUARE ROOT OF A POLYNOMIAL 
GIVEN THE POLYNOMIAL 



2 3 (N-I) 

P(X) = Cil)+C(2)*X+C(3)»X +C(4)*X +..i+C(N)*X 

WHERE C<1) IS GREATER THAN ZERO 

FIND THE FIRST M COEFFICIENTS OF THE SQUARE ROOT POWER 
SERIES. 



C 
C 
C 
C 
C 
C 
C 
C 

C LANGUAGE - FORTRAN II SUBROUTINE 

C EQUIPMENT - IBM 709 OR 7090 ( MAIN FRAME ONLY) 

C STORAGE - 155 REGISTERS 

C SPEED - 3 ♦ M ♦ .06»M»M MILLISEC ON IBM 709 

C AUTHOR - J. CLAERBOUT 

C 

C -USAGE 

C 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 
C AND FORTRAN SYSTEM ROUTINES - SQRT 

C 

C FORTRAN USAGE 

l Call kSwki , r f a i 

C 

C INPUTS 
C 
C 
C 
C 

c 
c 
c 
c 

C M 
C 
C 

C OUTPUTS 
C 

C Ad) 
C 
C 

C EXAMPLES 
C 



cm 



THE NUMBER OF COEFFICIENTS IN THE POLYNOMIAL T® BE ROOTED 
MUST BE GREATER THAN OR =4(THIS IS NO SEVERE RESTRICTION 
HOWEVER SINCE ANY OF C(2),C(3), AND/OR C(4t MAY * ZERO* ) 

I«i,N IS THE VECTOR OF COEFFICIENTS OF THE POLYNOMIAL 
WHICH IS TO BE ROOTED. C(l) MUST EXCEED ZERO. 

THE NUMBER OF COEFFICIENTS DESIRED IN THE SQUARE ROOT 
POWER SERIES. 



1 = 1, M 



THE VECTOR OF THE FIRST M COEFFICIENTS IN THE 
SQUARE ROOT POWER SERIES. 



C 1. 

c 
c 
c 
c 
c 

C 2. 

C 
C 
C 
C 

c 
c 
c 
c 



INPUTS 



- N=4 
C(l. 



M=6 

.4) =l.,-4.,4.,0. 



(NOTICE C(4) MUST BE DEFINED 
EVEN THOUGH IT IS ZERO. I 
OUTPUTS - A(1...6)=l.,-2.,0.,0.,0.,0. 

(THE POWER SERIES DEGENERATES TO POLYNOMIAL) 

INPUTS - N=4 M=15 

C( 1.* .4)=i. ,2. ,0. ,0. 
OUTPUTS - A(1...15)=l.,l.,-.5,.5,-.625,.875,-1.31,2.06,-3.35,5.58i 
-9.49, 16.4.-28. 7,50.7.-90. 

(IN THIS EXAMPLE THE RADIUS OF CONVERGENCE OF 
THE POWER SERIES IS .5, THEREFORE THE COEFS. 
TEND TO INCREASE. OVERFLOW WOULD OCdUR SOME- 
WHERE AROUND THE 120 TH COEFF IC IENT. ) 

OIMENSION A(100),C(100) 
A(l)=SQRTF(C(l)) 
TA=2.*A(1) 
A(2)=C(2)/TA 

A(3)=(C( 3)-A(2)*A(2) )/TA 
DO 100 1*4, M 
IF(I-N), 20,20,10 



0090 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 

0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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* PSQRT * * PSQRT * 

***##»*»«»****»*##«##♦#* *•*#**•**••«**••******•* 
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to 


PA=0. 


0075 




GO TO 30 


0076 


20 


PA=C ( I ) 


0077 


30 


CONTINUE 


0078 




PS=0. 


0079 




IHM/2 


0080 




00 40 J=2 f IH 


0081 




K=I-J 


0082 


40 


PS=PS + A( J}*A(K+1) 


0083 




PA=PA-2.*PS 


0084 




IF(2*IH-I) 50,60,50 


0085 


50 


PA=PA-A{ IH+1 )«A UH+1) 


0086 


60 


A( I )=PA/TA 


0087 


100 


CONTINUE 


0088 




RETURN 


0089 




END 


0090 



•*••*•••«••*••**•**•*••» PROGRAM LISTINGS ««******»#«*»««*«4+«»*»» 

» PWMLIV » * PWMLIV * 

»*•»•*«**»*•**«**••••*•* #**«**»#•***••#»*•»•»*•* 



» PWMLIV ( SUBROUTINE ) 9/29/64 LAST CARD III DECK IS NO* 

• LABEL 

CPWMLIV 

SUBROUTINE PWML I V < JOB, I T APE, ML IV,LML I V, I ANS ) 

C 

C ABSTRACT 

C 

C TITLE - PWMLIV 

C PRINT OR WRITE OUTPUT TAPE A MACHINE LANGUAGE INTEGER VECTOR 

C 

C PWMLIV IS AN ELEMENTARY OUTPUT PROGRAM FOR ML I VECTORS! 

C PRINTING 1 TO 10 WORDS PER LINE AND ALWAYS 12 CHARACTERS 

C PER WORD. OUTPUT IS EITHER ON-LINE OR ON LOGICAL TAPE 

C AS SPECIFIED BY AN ARGUMENT • 

C 

C LANGUAGE - FORTRAN II SUBROUTINE 

C EQUIPMENT - 709 OR 7090, MAIN FRAME PLUS 1 TAPE AND/OR ON-LINE PRINTER 
C STORAGE - 300 REGISTERS 
C SPEED 

C AUTHOR S.M. SIMPSON JR, JULY 1961 

C 

C USAGE 

C 

C TRANSFER VECTOR CONTAINS ROUTINES - MLI2A6 

C AND FORTRAN SYSTEM ROUTINES - <FIL), (SPH), (STH) 

C 

C FORTRAN USAGE 

C CALL PWMLIVtJOB* I TAPE, ML IV, LML IV , I ANS ) 



C INPUTS 
C 

JOB 



I TAPE 



MLIVU) 
LMLIV 



C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 

C OUTPUTS 
C 

c 
c 

C IANS 
C 
C 
C 
C 

C EXAMPLES 
C 

C i. INPUTS - J0B=1 MLIVU. ..15) * OCT 377777777777, 777777777777*0,1 ^ 
C 2,3,4,5,6,7,10, 11, 12,400000000013, 400000000000 LMLIV=15 

C ITAPE * 2 

C OUTPUTS - IANS=0 AND WE SHOULD GET THE FOLLOWING LIST 0*F-LINE 

C IN FORMAT { 2 A6 ) 34359738367, -34359738367*0*1*2, 3, 4%5,6i 



= *N OR -N WHERE N * DESIRED NO. OF WORDS/LINE 

AND + MEANS OFF-LINE OUTPUT, - MEANS ON-LINE OUTPUT* 

AND 1 LSTHN= N LSTHN= 10 

IS NOT USED FOR JOB NEGATIVE 

IS LOGICAL NO. OF DESIRED OUTPUT TAPE FOR JOB ROSITIVE 
IN THIS CASE ITAPE MUST HAVE VALUE 1...20 INCLUSIVE 

1*1... LMLIV IS THE ML I VECTOR. 

GRTHN= 1 



PRINCIPAL OUTPUT IS PRINTED COPY 

» 0 JOB DONE 
=-1 ILLEGAL JOB NO. 
=-2 ILLEGAL ITAPE 
=-4 ILLEGAL LMLIV 



c 








7,8,9,10,-11,-0 






c 

c 


2. 


INPUTS 




SAME 


AS 


EXAMPLE 


1. 


EXCEPT 


c 




OUTPUTS 




SAME 


AS 


EXAMPLE 


1. 


EXCEPT 


c 
c 


3. 


INPUTS 




SAME 


AS 


EXAMPLE 


1. 


EXCEPT 


c 




OUTPUTS 




SAME 


AS 


EXAMPLE 


1. 


EXCEPT 


c 
c 


4. 


INPUTS 




SAME 


AS 


EXAMPLE 


1. 


EXCEPT 


c 
c 




OUTPUTS 




SAME 


AS 


EXAMPLE 


3. 


EXCEPT 


c 


5. 


INPUTS 




SAME 


AS 


EXAMPLE 


1. 


EXCEPT 


c 




OUTPUTS 




SAME 


AS 


EXAMPLE 


1. 


EXCEPT 


c 
c 


6. 


INPUTS 




SAME 


AS 


EXAMPLE 


1. 


EXCEPT 



EXCEPT OUTPUT SHOULD BE ON-LINE. 
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c 


OUTPUTS 


— 


SAME 


AS 


c 










C 7. 


INPUTS 




SAME 


AS 


C 


OUTPUTS 


- 


SAME 


AS 


C 










C 8. 


INPUTS 


— 


SAME 


AS 


C 


OUTPUTS 




IANS* 


-1 


C 










C 9. 


INPUTS 




SAME 


AS 


C 


OUTPUTS 




IANS= 


-1 


C 










CIO. 


INPUTS 




SAME 


AS 


C 


OUTPUTS 




IANS= 




C 










Cll. 


INPUTS 




SAME 


AS 


c 


OUTPUTS 




IANS= 


-2 


c 











EXCEPT F0RMATU0A6) 



EXCEPT JOB=ll 



EXCEPT LMLIV=0 



EXCEPT ITAPE = 0 



DIMENSION MLIV(2) , BUF(20) 
C CHECK INPUTS JOB, ITAPE AND LMLIV 
IANS=-1 

IE (JOB) 10,9999,20 
10 IF (10+JOB) 9999,30,30 
20 IE (JOB-10) 30*30,9999 
30 IANS * -2 

IF ( ITAPE-l) 9999,40,40 
40 IF (ITAPE-20) 50,50,9999 
50 IANS * -4 

IF (LMLIV) 9999,9999,100 
C SET UP NRGLNS,NWREG#NWLST,NXMLI 
100 NWREG= JOB 

IF (JOB) 110,120,120 
110 NWREG*-JOB 
120 NRGLNS^LMLI V/NWREG 

NWLST*LMLIV-NRGLNS»NWREG 

NXMLI=1 

NRREG*2*NWREG 

IANS^O 

GO TO 200 

C TREAT REGULAR LINES IF THERE ARE ANY 
200 IF (NRGLNS) 300,300,220 
220 DO 280 I=1»NRGLNS 

DO 240 J=l , NWREG 

K*2*J-1 

CALL MLI2A6<MLIV(NXMLI ) , 8UF ( K ) , NCRS ) 
240 NXMLI=NXMLI+1 

IF (JOB) 270,270,260 
260 WRITE OUTPUT TAPE ITAPE, 700, { BUF( J) , J*1,NRREG) 

GO TO 280 
270 PRINT 700,(BUF(J),J*1,NRREG) 
280 CONTINUE 

GO TO 300 

C WORK ON LAST LINE OF OUTPUT IF ANY 
300 IF (NWLST) 9999,9999,320 
320 DO 330 1*1, NWLST 
J=2*I-1 

CALL MLI2A6(MLIV(NXMLI ),BUF( J), NCRS) 
330 NXMLI*NXMLI+1 
NRLST=2*NWLST 
IF (JOB) 350,350,340 
340 WRITE OUTPUT TAPE ITAPE, 700 , ( BUF C J ) , J=l ,NRLST) 
GO TO 9999 
350 PRINT 700,(BUF(J), J*1,NRLST) 
GO TO 9999 
C ONLY FORMAT STATEMENT 

700 FORMAT (1H ,20A6) 
C EXIT 
9999 RETURN 
END 
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• QACORR {SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0183 

• LABEL 0001 
C QACORR 0002 

SUBROUTINE QACORR ( X, LX, MXACC, MXL AGtSPACEf ACOR, IANS ) 0003 

C 0004 

C ——ABSTRACT 0005 

C 0006 

C TITLE - QACORR 0007 

C FAST AUTOCORRELATIONS FOR LONG, LIMITED ACCURACY SERIES 0008 

C 0009 

C QACORR COMPUTES THE UNNORMAL IZED AUTOCORRELATION 0010 

C FUNCTION, AC(L), OF A LIMITED ACCURACY SERIES, XI I I OF 0011 

C LENGTH LX, ACCORDING TO THE TRANSIENT FORMULA 0012 

C 0013 

C 1 LX-L 0014 

C ACU) = * SUM C X(I)»X(I*L) ) 0015 

C LX 1*1 0016 

C 0017 

C FOR L « 0,1,...,MXLAG 0018 

C 0019 

C WHERE MXLAG AND LX ARE INPUT PARAMETERS 0020 

C 0021 

C SPEED DEPENDS ON LX AND ACCURACY OF X. FOR VERY LONG 0022 

C SERIES A COMPLETE AUTOCORRELATION t MXLAG = LX-U CAN BE 0023 

C COMPUTED IN SLIGHTLY MORE THAN ( LX )SQUARED MACHINE CYCLES* 0024 

C QACORR OBTAINS THIS SPEED PRIMARILY BY CONVERTING X C IS TO 0025 

C AN INTEGER SEQUENCE IX(I) WHOSE MAGNITUDES HAVE UPPER 0026 

C LIMIT AS SPECIFIED BY AN INPUT PARAMETER MXACC, AND THEN 0027 

C REGROUPS THE ABOVE EQUATION (FOR EACH LAG) SO AS TO 0028 

C PERFORM LX-L ADDITIONS PLUS MXACC IOR FEWER I MULTIPLE 0029 

C CATIONS (RATHER THAN LX-L ADDITIONS PLUS LX-L MULTIPLI- 0030 

C CATIONS). THE RESULTS ARE THEN RECONVERTED TO FLOATING 0031 



C FASCOR FOR LOGIC DETAILS.) IXC I) IS ALSO REFLOATED* 0033 

C 0034 

C USER MUST PROVIDE QACORR WITH A BLOCK OF TEMPORARY 0035 

C REGISTERS OF LENGTH LX + 10*<MXACC+1) ♦ 1 . 0036 

C 0037 

C XU) IS LEFT SLIGHTLY MODIFIED BY THE FIXING, REFLOATING 0038 

C PROCESS. 0039 

C 0040 

C LANGUAGE - FORTRAN II SUBROUTINE 0041 

C EQUIPMENT - 709, 7090 (MAIN FRAME ONLY) 0042 

C STORAGE - 207 REGISTERS 0043 

C SPEED - FOR LONG SERIES QACORR TAKES ABOUT 0044 

C (MXLAG+l)*(2*LX-MXLAG*20»MXACC) MACHINE CYCLES 0045 

C AUTHOR - S. M. SIMPSON JR, 10/5/62 0046 

C 0047 

C USAGE 0048 

C 0049 

C TRANSFER VECTOR CONTAINS ROUTINES - FXDATA, PROCOR, FASCOR, FLDATA 0050 

C AND FORTRAN SYSTEM ROUTINES - NONE 0051 

C 0052 

C FORTRAN USAGE 0053 

C CALL QAC0RR(X,LX, MXACC, MXLAG, SPACE, ACOR, IANS) 0054 

C 0055 

C INPUTS 0056 

C 0057 

C XU) 1=1,2, ^..LX IS A FLOATING POINT VECTOR 0058 

C 0059 

C LX MUST EXCEED IER0 AND BE LSTHN* 10000 0060 

C 0061 

C MXACC DEFINES ACCURACY OF X(I). XU ) WILL BE FIXED TO HAVE 0062 

C VALUES LYING BETWEEN -MXACC AND +MXACC INCLUSIVE * 0063 

C MUST LIE BETWEEN 1 AND 1000 INCLUSIVE. C SMALLER VALUES 0064 

C YIELD HIGHER SPEEDS, AND REQUIRE FEWER TEMPORARIES* ) 0065 

C 0066 

C MXLAG IS HIGHEST LAG NO. DESIRED IN AUTOCORRELATION 0067 

C MUST BE NON-NEGATIVE 0068 

C 0069 

C SPACE(I); I = 1,...,LSPACE MUST BE AVAILABLE AS TEMPORARIES, WHERE 0070 

C LSPACE « LX ♦ 10«<MXACC+1) +1 0071 

C 0072 

C OUTPUTS 0073 

C 0074 



PROGRAM LISTINGS 



• QACORR 
(PAGE 2) 



«*•**••**••»*#•»••***•** 

# QACORR » 
«••***•«*«••*•••••«•«*•* 

(PAGE 2) 



X(I) 



ACOR(I) 



IANS 



1*1,2, ...,LX CONTAINS THE ROUNDEO SERIES XXII I 
XXU) * FLOAT F( IX( I))/ SCALE 

WHERE 

IX(I) = XFIXFIX4 I)*SCALE) 

WITH 

SCALE = FLOATF<MXACC)/XMAX 
XMAX = LARGEST X MAGNITUDE 
(NOTE- XFIXF IN ABOVE EXPRESSION IMPLIES ROUNDING 
TO NEAREST INTEGER, NOT TRUNCATION) 
X(I) WILL 8E LEFT » 0.0 IF XMAX * 0.0 

1*1,2,... ,(MXLAG+1) WILL CONTAIN ACU), L*0, 1, ... i MXLAG 
COMPUTED ON THE ROUNCED SERIES XXU) 

1 LX-L 

AC(L) = — * SUM ( XX(I)*XX(H-L) } 
LX 1=1 

= 0.0 FOR ALL L GRTHN LX-1 IF ANY 

ACORUJ WILL 8E IDENTICALLY 0.0 WHENEVER Xtl) 1S^ 

* 0 IF NO TROUBLE ARISES 

« -2 IF LX IS ILLEGAL 

= -3 IF MXACC IS ILLEGAL 

« -4 IF MXLAG IS ILLEGAL 



= -98 IF UNEXPLAINED ERROR RETURN FROM PROCOR OCCURS 
= -99 IF UNEXPLAINED ERROR RETURN FROM FASCOR OCCURS 

EXAMPLES THE FIRST 3 EXAMPLES ARE CHOSEN SO THAT THE ROUNDOFF 

EFFECT IS NOT PRESENT 

CALL QACORR ( X , LX , MX ACC , MXLAG, SPACE, ACOR, IANS) IS THE 
ASSUMED USAGE IN ALL EXAMPLES 

1. COMPLETE AUTOCORRELATION 

INPUTS - XU...5) = 10. ,20. ,10. ,10. ,5. , LX*5, MXACC = 20^ MXLAG** 
OUTPUTS - XU...5) = SAME AS INPUTS IANS^O 
AC0R(1...5> = 145., 110. ,70. ,40., 10. 

2. PARTIAL AUTOCORRELATION 

INPUTS - SAME AS EXAMPLE 1. EXCEPT MXLAG » 2 

OUTPUTS - SAME AS EXAMPLE 1. EXCEPT AC0R(4..5> NOT DEFINED 

3. AUTOCORRELATION BEYOND END OF SERIES 
INPUTS - SAME AS EXAMPLE 1. EXCEPT MXLAG=7 
OUTPUTS - SAME AS EXAMPLE 1. EXCEPT 

AC0RU...8) * 145., 110., 70. ,40., 10.,0.,0.,0. 
(I.E. TERMINAL ZEROES SUPPLIED) 

4. PARTIAL AUTOCORRELATION SHOWING ROUNDOFF 

INPUTS - X(l.*.3) = 23.8,148.0,20.3 LX=3 MXACC*100 MXLAG*0 
OUTPUTS - X(l.*.3) * 23.68,148.0,20.72 IANS=0 
ACOR(l) * 7631.354 

5. THE NEXT 3 EXAMPLES SHOW ERROR CONDITIONS 
INPUTS - SAME AS EXAMPLE 1. EXCEPT LX=0 
OUTPUTS - IANS =-2 (ILLEGAL LXi 

6. INPUTS - SAME AS EXAMPLE 1. EXCEPT MXACC=5000 
OUTPUTS - IANS =-3 (ILLEGAL MXACC) 

7. INPUTS - SAME AS EXAMPLE 1. EXCEPT MXLAG=-2 
OUTPUTS - IANS =-4 (ILLEGAL MXLAG) 

8. (SPECIAL TEST FOR BYPASS IN CASE ALL X(I)=0.) 

INPUTS - SAME AS EXAMPLE 1. EXCEPT X ( 1 . . . 5 ) =0. , 0* , . *. 
OUTPUTS - SAME AS EXAMPLE 1. EXCEPT ACOR ( 1 . . . 5) =0. , 0. , . . . 

PROGRAM FOLLOWS BELOW 

DIMENSION X(2),SPACE(2),AC0R(2) 
CHECK INPUTS 
IANS=-2 

IF (LX) 9999,9999,5 
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0123 
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5 IF (LX-IOOOO) 10,10,9999 0150 

10 IANS=-3 0151 

IF (MXACC) 9999,9999,20 0152 

20 IF (MXACC-1000) 30,30,9999 0153 

30 I ANS--4 0154 

IF (MXLAG) 9999,40,40 0155 

C CLEAR OUTPUT AREA 0156 

40 NNLAGS=MXLAG+1 0157 

DO 50 I=1,NNLAGS 0158 

50 ACOR(I)=0,0 0159 

C SET NO. LAGS » MIN ( MXL AG , LX-l > 0160 

NLAGS-MXLAG 0161 

IF (MXLAG-LX+1) 70t70,60 0162 

60 NLAGS=LX-1 0163 

C SET SPACE CONSTANT FOR PROCOR AND FIX X. EXIT IF X=ZERO VECTOR* 0164 

70 LSPACE*LX+10*(MXACC+1)+1 0165 

CALL FXDATA(LX,X,MXACC, SCALE) 0166 

IANS«0 0167 

IF (SCALE) 9999,9999,80 0168 

C THEN COMPUTE AUTOCORRELATIONS 0169 

80 IANS^-98 0170 

CALL PROCOR ( X,LX,MXACC,SPACE(LSPACE),SPACE(1),ANSR) 0171 

IF (ANSR) 900,100,900 0172 

100 IANS=-99 0173 

CALL FASCORCX, 0,NLAGS,ACOR, ANSR) 0174 

IF (ANSR) 900,120,900 0175 

C FLOAT AND SCALE ACCR 0176 

120 IANS=0 0177 

SCSQ=SCALE*SCALE»FLOATF(LX) 0178 

CALL FLDATA ( NNLAGS,ACOR, SCSQ ) 0179 

C REFLOAT X SERIES 0180 

900 CALL FLDATA(LX,X, SCALE) 0181 

9999 RtfUKN OioZ 

END 0183 
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QCNVLV (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0293 

LABEL 0001 



CQCNVLV 0002 
SUBROUTINE QCNVLV (XX, LXX,YY,LYY, MXACC, LCC, SPACE, CC, IANS) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - QCNVLV 0007 

C 0008 

C FAST CONVOLUTIONS FOR LONG, LIMITED ACCURACY SERIES 0009 

C 0010 

C QCNVLV COMPUTES THE CONVOLUTION* C(J), OF TWO LIMITED 0011 

C ACCURACY SERIES, X(I) 1=0. ..LX AND YU) 1=0. ..LY, 0012 

C ACCORDING TO THE FORMULA 0013 

C 0014 

C LX 0015 

C CIJ) = SUM ( XU)*YU-I) I 0016 

C 1*0 0017 

C 0018 

C FOR J = 0,1, ...,LC 0019 

C 0020 

C WHERE YCK) IS ASSUMED = 0.0 WHENEVER K IS 0021 

C OUTSIDE OF THE RANGE 0 TO LY 0022 

C LX,LY, AND LC ARE INPUT PARAMITERS 0023 

C 0024 

C TO OBTAIN HIGH SPEED THE X AND Y SERIES ARE CONVERTED TO 0025 

C INTEGER SEQUENCES WHOSE MAGNITUDES HAVE UPPER LIMIT AS 0026 

C SPECIFIED BY AN INPUT PARAMETER MXACC AND THEN REGROUPS 0027 

C THE ABOVE EQUATION SO AS TO SUBSTITUTE ADDITIONS FOR 0028 

C MULTIPLICATIONS (SEE PROCOR-F ASCOR-FASEPC FOR LOGIC 1 • 0029 

C THE RESULTS ARE THEN RECONVERTED TO FLOATING POINT FORM 0030 

C WITH COFRECT SCALE. THE INTEGER SEQUENCES FOR X AND Y 0031 

C ARE ALSO REFLOATED. 0032 

C 0033 

C USER MUST PROVIDE QCNVLV WITH A BLOCK OF TEMPORARY 0034 

C REGISTERS OF LENGTH LMIN ♦ 10»(MXACC+1) ♦ 1 0035 

C WHERE LMIN * MINIMUM(LX,LY3 ♦ 1 0036 

C 0037 

C XC 1 1 AND Yd) ARE LEFT SOMEWHAT MODIFIED BY THE FIXINGI 0038 

C REFLOATING PROCESS. 0039 

C 0040 

C LANGUAGE - FORTRAN II SUBROUTINE 0041 

C EQUIPMENT - 709 OR 7090 { MAIN FRAME ONLY) 0042 

C STORAGE - 569 REGISTERS 0043 

C SPEED - COMPLETE CONVOLUTIONS (LC=LX+LY) CAN BE COMPUTED IN A80UT 0044 

C 2*(LX+l)*(LC+l) MACHINE CYCLES IF LX MUCH LSTHN LY 0045 

C K2#(LX*l)«(LC+l) MACHINE CYCLES IF LX ABOUT = LY 0046 

C FOR LONG SERIES. 0047 

C AUTHOR - S.M* SIMPSON, 10/18/62 0048 

C 0049 

C USAGE 0050 

C 0051 

C TRANSFER VECTOR CONTAINS ROUTINES - FXDATA, PROCOR, FASCOR, FASEPC, 0052 

C FLDATA 0053 

C AND FORTRAN SYSTEM ROUTINES - XLOC 0054 

C 0055 

C FORTRAN USAGE 0056 

C CALL QCNVLVCXX, LXX,YY,LYY, MXACC, LCC, SPACE, CC, IANS) 0057 

C 0058 

C INPUTS 0059 

C 0060 

C XXII) I=1,2,...,LXX CONTAINS XIII I=0,l,*..,LX i LX*LXX-1 0061 

C 0062 

C LXX MUST EXCEED ZERO 0063 

C 0064 

C YYCI) 1=1 ,2,... ,LYY CONTAINS Y(I) I=0,l,i..,LY # LY*LYY-i 0065 

C EQUIVALENCE (XX, YY ) IS PERMITTED. HOWEVER NO PARTIAL 0066 

C CVERLAP OF XX AND YY IS ALLOWED. 0067 

C 0068 

C LYY MUST EXCEED ZERO 0069 

C 0070 

C MXACC SPECIFIES ACCURACY OF X AND Y. THESE WILL BE FIXED SO 0071 

C AS TO HAVE INTEGER VALUES FROM —MXACC TO +MXACC DURING 0072 

C THE COMPUTATIONS. 0073 
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C MUST EXCEED ZERO AND BE LSTHN= 1000 0074 

C 0075 

C ICC IS NUMBER OF TERMS OESIRED IN OUTPUT CONVOLUTION 0076 

C MUST EXCEED ZERO 0077 

C 0078 

C SPACE(I) 1=1,2,... ,LSPACE MUST BE AVAILABLE FOR TEMPORARY USE 0079 

C WHERE LSPACE = LMIN ♦ 10*(MXACC+1) 4- 1 0080 

C LMIN = LXX OR LYY WHICHEVER IS SMALLER 0081 

C LMIN MUST NOT EXCEED 10000 0082 

C 0083 

C OUTPUTS 0084 

C 0085 

C XXU) 1 = 1. ..LXX WILL CONTAIN THE REFLOATED X SERIES 0086 

C 0087 

C YYU) 1 = 1. ..LYY WILL CONTAIN THE REFLOATED Y SERIES 0088 

C (IN THE FIXING PROCESS ROUNOING IS USED RATHER THAN 0089 

C TRUNCATION SO THE REFLOATED SERIES SHOULD N0T SHOW 0090 

C SYSTEMATIC DISCREPANCIES FROM THE ORIGINALS) 0091 

C 0092 

C CCU) 1 = 1.. .LCC IS THE CONVOLUTION C(J) J=0, 1, ...,LC , LC«LCC-1 0093 

C AS DEFINED IN THE ABSTRACT, AND AS COMPUTED ®N THE 0094 

C FIXED VERSION OF THE X AND Y SERIES FOLLOWED BY 0095 

C FLOATING AND PROPER SCALING. 0096 

C 0097 

C IANS = 0 NORMALLY 0098 

C = -2 IF LXX IS ILLEGAL 0099 

C = -3 IF YY PARTIALLY OVERLAPS XX 0100 

C = -4 IF LYY IS ILLEGAL OR IF LMIN EXCEEDS 10000 0101 

C « — 5 IF MXACC IS ILLEGAL 0102 

C = —6 IF LCC IS ILLEGAL 0103 

C =-99 IF UNEXPLAINED ERROR RETURN OCCURS FROM PROCOR 0104 

C FASCOR OR FASEPC 0105 

C 0106 

C EXAMPLES 0107 

C 0108 
C THE FIRST 5 EXAMPLES ARE CHOSEN TO ELIMINATE THE ROUNDOFF 0109 

C EFFECT. 0110 

C 0111 

C INPUTS TO ALL EXAMPLES ARE ASSUMED THOSE OF EXAMPLE 1. 0112 

C EXCEPT AS NOTED. 0113 

C THE OUTPUT IANS IS EQUAL TO ZERO EXCEPT AS NOTED.* 0114 

C 0115 

C 1. COMPLETE CONVOLUTION OF XX(l...3) WITH YYU...7) 0116 

C INPUTS - XXC>1...3)=10.,20., 20. YY( 1 . . .7) =1 . , 10. , 1 . , 1. , I . , U , 1 . 0117 

C USAGE - CALL QCNVLV ( XX, 3, YY, 7*10, 9, SPACE, CC, IANS) 0118 

C CUTPUTS - XXIH...3) AND YYU...7) SAME AS INPUT (NO ROUN0OFF 0119 

C BECAUSE OF CHOICE OF XX YY) 0120 

C CC (^1... 9) = 10., 120., 230. ,230., 50., 50., 50., 40., 20. 0121 

C (IN THIS CASE LMIN=3, MXACC=10, SO SPACE(l) THRU SPACE 0122 

C (114) IS USED AS TEMPORARY) 0123 

C 0124 

C 2. REVERSED ORDER CONVOLUTION 0125 

C USAGE - CALL QCNVLV ( YY,7 , XX , 3, 10, 9, SPACE ,CC # I ANS ) 0126 

C CUTPUTS - SAME AS EXAMPLE 1. (I.E. ORDER OF INPUTS XX AND YY 0127 

C IMMATERIAL) 0128 

C 0129 

C 3. CONVOLUTION BEYOND END OF SERIES 0130 

C USAGE - CALL QCNVLV I XX, 3, YY, 7, 10, 12, SPACE »CC, IANS) 0131 

C OUTPUTS - SAME AS EXAMPLE 1. EXCEPT TERMINAL ZEROES ARE ADDEO 0132 

C TO CC, I.E. 0133 

C CCU.. 12) = 10., 120., 230., 230., 50., 50., 50., 40., 20., 0.,0. ,0. 0134 

C 0135 

C 4. PARTIAL CONVOLUTION 0136 

C USAGE - CALL QCNVLV ( XX , 3, YY , 7, 10, 3, SPACE ,CC * I ANS ) 0137 

C OUTPUTS - CC(1...3)=10.,120.,230. 0138 

C 0139 

C 5. COMPLETE AUTOCONVOLUT ION 0140 

C USAGE - CALL QCNVLV ( XX, 3, XX, 3*10, 5, SPACE, CC ♦ IANS) 0141 

C OUTPUTS - CC<1...5)=100.,400.,800.,800.,400. 0142 

C 0143 

C 6. PARTIAL AUTOCONVOLUTION SHOWING ROUNDOFF EFFECT WITH MXAGC=100 0144 

C INPUTS - XXII. ..3)=14. 75, 9.41,-20.0 0145 

C USAGE - CALL QCNVLV ( XX, 3 , XX , 3, 100, 2, SPACE , CC, I ANS) 0146 

C CUTPUTS - XXH*.*3) = 14.80,9.40,-20.00 0147 
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CCU.. .25=219.04, 278. 24 



THE NEXT 5 EXAMPLES SHOW ERROR CONDITIONS 



USAGE 
OUTPUTS 



8. USAGE 



CALL QCNVLV ( XX f 0 , YY, 2, 10, 4, SPACE* CC , I ANS ) 
- I ANS=-2 {ILLEGAL LXX) 



OUTPUTS - 



USAGE 



OUTPUTS 



CALL QCNVLV ( XX, 10, XX ( 3 ) , 3, 10, 9, SPACE, CC * I ANS) 
OR GALL QCNVLV i YY( 2 ) , 3, YY , 5, 10, 4, SPACE *CC, J ANSI 
I ANS=-3 (XX AND YY PARTIALLY OVERLAP) 

CALL QCNVLV ( XX, 10, YY,~3, 10,4, SPACE, CC, IANS1 
OR CALL QCNVLV (XX, 10100, YY, 15000, 10, SPACE ) 
I ANS=-4 (ILLEGAL LYY OR LMIN) 



10. USAGE 



CALL QCNVLV (XX, 10, YY, 3, 1500,4, SPACE^CC, IANS) 
OR CALL QCNVLV < XX, 10, YY, 3,0, 4, SPACE, CC, IANS ) 
OUTPUTS - IANS*-5 (ILLEGAL MXACC) 

11. USAGE - CALL QCNVLV ( XX, 10, YY, 3 , 10 , 0, SPACE, CC , I ANS) 
OUTPUTS - I ANS=-6 

12. SPECIAL CASE TEST - XX OR YY ALL ZERO 

INPUTS - SAME AS EXAMPLE 1. EXCEPT XX( 1. . . 3 ) =0. , 0. , 0. 
USAGE - CALL QCNVLV ( XX,3,YY, 7, 10,9, SPACE, CC, IANS) 

OR CALL QCNVLV ( YY , 7, XX , 3, 10, 9, SPACE ,CC , I ANS ) 
OUTPUTS - CCU...9}=0.,0.,... 

13. SPECIAL CASE TEST - UNIT LENGTH XX 

USAGE - CALL QCNVLV* i XX, 1, YY , 7*10, 7, SPACE, CC , IANS ) 

OUTPUTS - CC(1... 7)^10. ,100. ,10. ,10. ,10. ,10. ,10. 

14. SPECIAL CASE TEST - LYY=LXX-1 (NO MIDDLE TERMS IN CONVOLUTION! 
USAGE - CALL QCNVLV ( XX , 3, YY , 2, 10, 4, SPACE, CC, I ANS ) 
OUTPUTS - CC(1..*4)=10.,120.,220.,200. 

DIMENSION XX(2),YY(2),CC(2),CM(2),SPACE(2) 
COMMON CM 
BRING IN LENGTHS, MXACC AND CHECK 
LX-LXX 
LY=LYY 
LC=LCC 
MAX^MXACC 
IANS*-2 

9999,9999,30 



30 



40 



50 
60 



9999,9999,40 

9999,9999,50 

60,60,9999 



IF(LX) 
IANS=-4 
IF(LY) 
IANS=-5 
IF(MAX) 
IF(MAX-IOOO) 
IANS=-6 
IF(LC) 9999,9999,80 
FIND LONGEST, SHORTEST SERIES AND INDICES W.R.T. COMMON 
80 LSHORT=XMINCF<LX,LY) 
LL0NG=XMAX0F ( LX ,LY ) 
L0CCM*XL0CF(CM) 
I X=LOCCM-XLOCF ( XX ) +1 
IY=L0CCM-XL0CF(YY)+1 
ISHORT=IX 
ILONG=IY 

IF(LX-LY) 100,100,90 
ISHORT^IY 
ILONG=IX 

CHECK FOR OVERLAP (ONLY PERMIT IDENTITY, BUT PERMIT UNEQUAL LENGTHS IF 
IDENTICAL) 
I ANS=-3 
IDIFF-IX-IY 

IF( IDIFF) 120,130,110 
IF ( IDIFF— LY) 9999,130,130 
IF(-IDIFF-LXJ 9999,130, 130 

R OUTPUT ARE^,j FIX LONGEST AND (IF NOT IDENTICAL) SHORTEST* 5 
REVERSE SHORTEST 
IANS=0 

DO 140 1=1, LC 
CC(I)-0.0 

CALL FXDATA ( LLONG,CM( I LONG) ,MAX,SLONG) 



90 



100 



140 
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0148 
0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
0197 
0198 
0199 
0200 
0201 
0202 
0203 
0204 
0205 
0206 
0207 
0208 
0209 
0210 
0211 
0212 
0213 
0214 
0215 
0216 
0217 
0218 
0219 
0220 
0221 
0222 
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SSHORT^SLONG 0223 

IF(SLONG) 9999,9999,150 0224 

150 IF(IDIFF) 160,170,160 0225 

160 CALL FXDATA (LSHORT,CM( I SHORT ), MAX, SSHORT ) 0226 

IF (SSHORT) 910#910,170 0227 

170 ASSIGN 300 TO IREV 0228 

GO TO 200 0229 

C INTERNAL SUBROUTINE TO REVERSE SHORTEST 0230 

200 LHAF=LSH0RT/2 0231 

IF(LHAF) 230,230,210 0232 

210 DO 220 I«1,LHAF 0233 

J*ISH0RT+I-1 0234 

K=ISHORT+LSHORT-I 0235 

TEMP<M(J) 0236 

CM(J)=CM(K) 0237 

220 CM(K)=TEMP 0238 

230 GO TO IREV, (300^704,910 ) 0239 
C FIND NO. TERMS TO BE COMPUTED BY EACH OF THE THREE FASCOR, FASEPC »CALLS 0240 

C NCL=LEFT TERMS (FASCOR), NCM^MID TERMS (FASEPC), NCR*RIGHT TERMS 0*41 

C SET FIRST LLC=ACTUAL NO. TERMS WHICH NEED TO BE COMPUTED. 0242 

300 LLC=XMIN0F(LC,LX+LY-1) 0243 

NCL=XMINOF ( LLC, L SHORT ) 0244 

NCM=0 0245 

IF(LLC-NCL) 320,320,310 0246 

310 NCM=XMIN0F(LLC-NCL,LL0NG-NCL-1) 0247 

320 NCR=0 0248 

IF ( NCL+NCM-LLC) 330,700,700 0249 

330 NCR=LLC— LLONG+1 0250 

C SET UP PROGRAM FOR SHORTEST 0251 

700 IANS*-99 0252 

LSPACE*NCL+10*(MAX+1)+1 0253 

INCL=I SHORT+LSHORT-NCL 0254 

CALL PRncnRir.wf lissri ) . Nir i . max • Ar.F f i ^PAPPi ? <;oArei i upbbh 92*5 

C REREVERSE SHORTEST IF AUTOCONVOLUT ION 0256 

IF (IDIFF) 704,702,704 0257 

702 ASSIGN 704 TO IREV 0258 

GO TO 200 0259 

704 IF (ERR1) 900,710,900 0260 

C CONVOLVE UP TO DISTANCE OF SHORTEST 0261 

710 MI NLAG=s~NCL+ 1 0262 

CALL FASCOR(CM( ILONG ) , M INL AG,0, CC ( NCL ) , ERR2 ) 0263 

IF ( ERR2) 900,720,900 0264 

C CONVOLVE MIDDLE TERMS IF ANY 0265 

720 IF(NCM) 740,740*730 0266 

730 ICCM*NCL+NCM 0267 

MI NLAG--NCM+1 0268 

I LONGM= I LONG+NCM 0269 

CALL FASEPCtCM( 1L0NGM) , MINL AG*0, CC( ICCM),ERR3) 0270 

IF (ERR3) 900,740,900 0271 

C CONVOLVE TAIL TERMS IF ANY 0272 

740 IF(NCR). 760,760,750 0273 

750 ICCR*NCL+NCM+1 0274 

MAXLAG-NCR-l 0275 

ILONGR « ILONG+NCM+1 0276 

CALL FASCOR ( CM ( ILONGR) ,0, MAXL AG, CC( ICCR),ERR4) 0277 

IF(ERR4) 900,760,900 0278 

C FLOAT CONVOLUTION 0279 

760 IANS*0 0280 

SCONV«SSHORT*SLQNG 0281 

CALL FLDATA(tLLC#CC,SCONV) 0282 

C RE-REVERSE SHORTEST, REFLOAT LONGEST AND (MAYBE) SHORTEST 0283 

C (BUT AVOIO REREVERSE FOR AUTO-CONVOLUTION) 0284 

900 IF (IDIFF) 902,910,902 0285 

902 ASSIGN 910 TO IREV 0286 

GO TO 200 0287 

910 CALL FLDATAI LLONG, CM ( I LONG) ,SLONG) 0288 

IF( IDIFF) 920,9999,920 0289 

920 CALL FLDATAfLSHORT ,CM( I SHORT) , SSHORT) 0290 

C EXIT 0291 

9999 RETURN 0292 

END 0293 
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• QFURRY (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0180 

» LABEL 0001 

CQFURRY 0002 
SUBROUTINE QFURRY ( X, LX, IXZER , M, JM I N r JMAX, SPACE, CSP, SSP , *ANS) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - QFURRY 0007 

C FAST FOURIER TRANSFORM OF TRANSIENT WITH ARBITRARY TIME ORIGIN 0008 

C 0009 

C QFURRY USES SUBROUTINE XSPECT TO OBTAIN A HIGH SPEED 0010 

C FOURIER TRANSFORM OF THE TIME SERIES XII), I»l».«LX t 0011 

C BASED ON THE ASSUMPTION THAT THE INDEX I*IXZER IS TO 0012 

C CORRESPOND TO THE ZERO TIME ORIGIN, WHERE IXZER IS 0013 

C ARBITRARILY SPECIFIED < IT MAY BE NEGATIVE); THE OUTPUTS 0014 

C ARE THE REAL AND IMAGINARY PARTS OF THE FOURIER TRANSFORM 0015 

C AND ARE EVALUATED OVER AN ARBITRARILY SPECIFIED FREQUENCY 0016 

C RANGE WITH AN ARBITRARY FREQUENCY INCREMENT, 0017 

C 0018 

C THE COMPUTATION IS AS FOLLOWS. THE ORIGINAL SiRIES 0019 

C X(I) 1=1. ..LX 0020 

C UNDERGOES A TRANSLATION OF ORIGIN TO BECOME 0021 

C 0022 

C XTU) 1= L,L+1,.*.,N 0023 

C WHERE 0024 

C L = 1 - IXZER (NOTE L AND POSSIBLY N 0025 

C N = LX - IXZER MAY BE NEGATIVE) 0026 

C 0027 

C THE REAL AND IMAGINARY PARTS ARE THEN COMPUTED ON THE 0028 

C TRANSLATED SERIES XTU) AS FOLLOWS 0029 

C 0030 

C N 0031 

C CS(J> » SUM ( XT( I)*C0S( I*J*PI/M) ) 0032 

C I=L 0033 

C 0034 

C N 0035 

C SS(J) * SUM ( XT( I)*SIN( I*J*PI/M) ) 0036 

C I=L 0037 

C 0038 

C FOR J « JMIN, JMIN+l,.*., JMAX 0039 

C WHERE 0040 

C PI - 3.14159265 0041 

C M, JMIN AND JMAX ARE INPUT PARAMETERS 0042 

C WITH THE RESTRAINT THAT 0043 

C 0 LSTHN* JMIN LSTHN JMAX LSTHN- M 0044 

C 0045 

C A BLOCK OF TEMPORARY REGISTERS IS REQUIRED 0046 

C OF LENGTH = LSPACE = 2*(M+K) ♦ 6 0047 

C WHERE 0048 

C M IS DEFINED ABOVE 0049 

C K = GREATEST DISTANCE FROM THE ZERO INDEX 0050 

C TO THE TWO ENDS OF THE X SERIES* 0051 

C I.E. K = MAGNITUDE OF L OR N, AS 0052 

C DEFINED ABOVE, WHICHEVER IS GREATER 0053 

C 0054 

C LANGUAGE - FORTRAN II SUBROUTINE 0055 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0056 

C STORAGE - 244 REGISTERS 0057 

C SPEED - (CONTROLLED PRIMARILY BY SUBROUTINE XSPECT) 0058 

C FOR M LSTHN* K - 36* ( JMAX-JMIN+ 1 ) *M MACHINE CYCLES 0059 

C FOR M GRTHN K - 72* ( JMAX-JM IN+1 ) *M MACHINE CYCLES 0060 

C AUTHOR - S.M. SIMPSON JR., JUNE 1963 0061 

C 0062 

C USAGE 0063 

C 0064 

C TRANSFER VECTOR CONTAINS ROUTINES - STZ, MOVE, COSTBL, SINTBL, XSPECT 0065 

C AND FORTRAN SYSTEM ROUTINES - (NONE) 0066 

C 0067 

C FORTRAN USAGE 0068 

C CALL QFURRYIX,LX, IXZER, M, JMIN, JMAX, SPACE, CSP, SSP, IANS) 0069 

C 0070 

C INPUTS 0071 

C 0072 

C X(I) I»1...LX LS THE INPUT TIME SERIES 0073 

C 0074 
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LX 

IXZER 
M 

JMIN 
JMAX 

SPACE (I ) 

OUTPUTS 
CSP(I) 

SSP(I) 

IANS 

EXAMPLES 



MUST EXCEED 1 

IS THE ZERO TIME INDEX. 
AND MAY EXCEED LX. 



MAY BE POSITIVE OR NEGATIVE 



CONTROLS THE FUNDAMENTAL FREQUENCY INCREMENT DESIRED AS 

SHOWN IN ABSTRACT. 
MUST EXCEED ZERO. 

CONTROLS THE LOWEST MULTIPLE OF THE FUNDAMENTAL 

FREQUENCY INCREMENT DESIRED, AS SHOWN IN ABSTRACT. 
MUST BE NCN-NEGATIVE 

CONTROLS THE GREATEST MULTIPLE OF THE FUNDAMENTAL 

FREQUENCY INCREMENT DESIRED, AS SHOWN IN ABSTRACT. 
MUST EXCEED JMIN AND BE LESS THAN OR EQUAL TO M 

I=1.*.LSPACE MUST BE AVAILABLE FOR SCRATCH, WHERE 
LSPACE IS DEFINED IN ABSTRACT. 



1=1,2,*.., JMAX-JMIN+1 CONTAINS CS(J), J=JMIN , . . . , JHAX , 
AS DEFINED IN ABSTRACT. 



1 = 



1,2,*.. JMAX-JMIN+l CONTAINS SSU), J=JMIN, ... , JMAX , 
AS DEFINED IN ABSTRACT. 



= 0 NORMALLY 

* -1 IF LX IS ILLEGAL (NO OTHER OUTPUT IN THIS CASE) 

= -2 IF M IS ILLEGAL DITTO 

» -3 IF JMIN OR JMAX IS ILLEGAL DITTO 



I. SIMPLE TIME SERIES WITH VARIOUS IXZER VALUES 
INPUTS - XU...3) = i.,1.,1. LX=3, M = lO, 
USAGE - CALL QFURRY ( X , LX , 1 , M , JMN, JMX 

CALL QFURRY(X,LX,2,M, JMN, JMX 
CALL QFURRY(X,LX,3,M, JMN, JMX 
CALL QFURRY(X,LX,0,M, JMN, JMX 
CALL QFURRY ( X , LX ,4, M, JMN, JMX 
OUTPUTS - IANSi=IANS2=IANS3=IANS4*IANS5=0 



3.00000, 
0.00000, 
3.00000, 
0.00000, 
3.00000, 



2.76008, 
0.89681, 
2.90212, 
0.00000, 
2.76008, 



CSPK1...3) 
SSPK i*..3) 
CSP2( 1...3) 
SSP2M...3) 
CSP3( 1...3) 
SSP3( 1...3) 
CSP4( 1-..3) 
SSP4U...3) 
CSP5( 1...3) 
SSP5( 1...3) 

ILLEGAL CONDITIONS 

USAGE - CALL QFURRY ( X , 1 , 1 , 2,0, 2, SPACE, CSP , SSP, I ANSI > 

CALL QFURRY(X,3,1,0,0,2,SPACE*CSP,SSP,IANS2> 
CALL QFURRY (X, 3, 1,2, -1,2* SPACE, CSP,SSP, IANS 3) 
CALL QFURRY (X, 3, 1,2, 0,3, SPACE, CSP,SSP, I ANS4) 
OUTPUTS - IANS1 =* -1 (ILLEGAL LX ) 

M) 



0.00000,-0.89681,- 
3.00000, 2.34787, 
0.00000, 1.70583, 
3.00000, 2.34787, 
0.00000,-1.70583,- 



JMN*0, JMX=2 
,SPA,CSP1,SSPUIANS1) 
,SPA,CSP2,SSP2, I ANS2 ) 
,SPA,CSP3,SSP3, I ANS3) 
,SPA,CSP4,SSP4,IANS4) 
,SPA,CSP5,SSP5,IANS5) 
AND 
11804 
53885 
61804 
.00000 
.11804 
.53885 
.80902 
.48991 
.80902 
.48991 



IANS1 
IANS2 
IANS3 
IANS4 



-1 
-2 
-3 
-3 



(ILLEGAL 
(ILLEGAL JMIN) 
(ILLEGAL JMAX) 



PROGRAM FOLLOWS BELOW 



DUMMY DIMENSIONS 

DIMENSION X(2), SPACE(2) 
CHECK LX AND M 

IANS * -1 

IF (LX-1) 9999,9999,10 
10 IANS » -2 

IF (M) 9999,9999, 20 

MAKE SETTINGS FOR SINE AND COSINE TABLE 
20 IXCSTB * I 



AND START OF CORR. BLOCK 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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IXSNTB = M+2 0150 

IXCRNG = 2*M+3 0151 

C FORM MAGNITUDES OF L AND N, ANC CHECK LARGEST 0152 

MAGL « XABSF (I - IXZER) 0153 

MAGN * XABSF (LX-IXZER) 0154 

IF (MAGN-MAGL) 120,100,100 0155 

C SET UP CONSTANTS FOR POS. BRANCH OF XTU) LONGEST 0156 

100 K = MAGN 0157 

IXXMOV * IXCRNG ♦ 2*K+i - LX 0158 

GO TO 130 0159 

C SET UP CONSTANTS FOR NEG. BRANCH OF XT(I) LONGEST 0160 

120 K = MAGL 0161 

IXXMOV « IXCRNG 0162 

C MAKE OTHER SETTINGS DEPENDENT ON K ALONE 0163 

130 IXXCOR » IXCRNG ♦ K 0164 

LCR * 2*K+1 0165 

C CLEAR THE CORRELATION AREA, THEN MOVE IN THE X SERIES 0166 

CALL STZCLCR, SPACE (IXCRNG)) 0167 

CALL MOVE ( LX,X,SPACEUXXMOV) ) 0168 

C NOW SET UP THE COSINE AND SINE TABLES 0169 

CALL COSTBL (M, SPACEUXCSTB) ) 0170 

CALL SINTBL (M, SPACE (IXSNTB) ) 0171 

C FINALLY USE XSPECT, CHECKING FOR ILLEGAL JMIN, JMAX 0172 

IANS = -3 0173 

CALL XSPECT (SPACE (IXXCOR), K, SPACE (IXCSTB), SPACE (IXSNTBI, 0174 

1 M, JMIN, JMAX, CSP, SSP, SPACE UXXCOR), ERRI 0175 

IF (ERR) 9999,777,9999 0176 

777 IANS * 0 0177 

C EXIT 0178 

9999 RETURN 0179 

END 0180 
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» QIFURY I SUBROUTINE) 9/29/64 LAST CARD INI DECK IS NCw 0205 

* LABEL 0001 

CQIFURY 0002 
SUBROUTINE QI FURY < FT REAL » FT IMAJ ,MFREQ, LX, IXZER, SPACE, X, 1ANSI 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - QIFURY 0007 

C QUICK INVERSE FOURIER TRANSFORM WITH ARBITRARY TIME 0KI6IN 0008 

C 0009 

C QIFURY USES SUBROUTINE COSISP TO OBTAIN A TIME SERIES 0010 

C XU), I*1„*.LX » HAVING ITS TIME ORIGIN AT ARBITRARY 0011 

C INDEX IXZER, FROM THE REAL AND IMAGINARY PARTS OF THE 0012 

C FOURIER TRANSFORM OF X. THE INPUT FOURIER TRANSFORM 0013 

C IS GIVEN BY 0014 

C FTREAL( 1...MFREQ+1) - FTRI 0. . .MFREQ J 0015 

C AND FT IMAJ ( 1.. • MFREQ* 1) - FTI ( O...MFRFQ) 0016 

C WHERE 0017 

C FTR< J ) = REAL PART OF FOURIER TRANSFORM EVALUATED 0018 

C AT ANGULAR FREQUENCY W « J*PI/MFREQ 0019 

C FTIU) » IMAGINARY PART OF FOURIER TRANSFORM 0020 

C EVALUATED AT THE SAME FREQUENCY. 0021 

C 0022 

C THE COMPUTATION IS 0023 

C 0024 

C X(1...LX) * XT<L,L+1, ...N) 0025 

C WHERE L = 1 - IXZER 0026 

C N = LX - IXZER 0027 

C 0028 

C WHERE 0029 

C 1 W* + PI 0030 

C XTU) = INTEGRAL I FTR( W)*COS( I*W) ♦ 0031 

V* cr i. n — t i j t~ 

C FTMW)*SIN< I*W) } DW 0033 

C 0034 

C WHERE THE INTEGRAL IS PERFORMED BY TRAPEZOIDAL 0035 

C APPROXIMATION AND ASSUMES FTR AND FTI ARE EVEN 0036 

C AND ODD FUNCTIONS. 0037 

C 0038 

C A BLOCK OF 4*(MFREQ+1) TEMPORARY REGISTERS IS REQUIRED. 0039 

C 0040 

C QIFURY IS AN APPROXIMATE INVERSE OPERATOR TO QFURRY* 0041 

C THE INVERSE IS EXACT IF QFURRY AND QIFURY WERE 0042 

C CALLED WITH THE SAME MFREQ AND IXZER PROVIDED THE 0043 

C COMPLETE SPECTRUM (JMIN^O JMAX=MFREQ) WAS COMPETED 0044 

C BY QFURRY AND THAT LX WAS LSTHN* 2*MFREQ— 1, EXCEPT 0045 

C THAT THE OUTPUT FROM QIFURY IS PERIODIC WITH PERIOD 0046 

C 2*MFREQ 0047 

C 0048 

C LANGUAGE - FORTRAN-II SUBROUTINE 0049 

C EQUIPMENT - 709 OR 7090 I MA IN FRAME ONLY) 0050 

C STORAGE - 280 REGISTERS 0051 

C SPEED - 7090 709 0052 

C ABOUT (65 OR 72 ) * { MFREQ+l ) * < MFREQ+1 ) MACHINE CYCLES 0053 

C FOR LARGE MFREQ 0054 

C AUTHOR - S.M. SIMPSON, AUGUST 1963 0055 

C 0056 

C USAGE 0057 

C 0058 

C TRANSFER VECTOR CONTAINS ROUTINES - COSTBL, S INTBL,COSI SP 0059 

C AND FORTRAN SYSTEM ROUTINES - XLOC 0060 

C 0061 

C FORTRAN USAGE 0062 

C CALL QIFURY(FTR6AL,FTIMAJ, MFREQ, LX, IXZER, SPACE, X,IANS) 0063 

C 0064 

C INPUTS 0065 

C 0066 

C FTREALU) 1 = 1... MFREQ + 1 IS THE REAL PART OF THE FOURIER TRANSFROM 0067 

C 0068 

C FTIMAJ(I) I*i...MFREQ+l IS THE IMAGINARY PART OF THE FOURIER 0069 

C TRANSFORM 0070 

C 0071 

C MFREQ SHOULD EXCEED 0 0072 

C 0073 
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C LX SHOULD EXCEED 0 0074 

C 0075 

C IXZER SPECIFIES THE ZERO TIME INDEX OF XII). 0076 

C MAY BE ANY VALUE, POSITIVE OR NEGATIVE (MAY EXCEED LXl 0077 

C 0078 

C SPACE(I) I=1...LSPACE MUST BE AVAILABLE FOR SCRATCH* 0079 

C WHERE LSPACE = 4*M ♦ 4 0080 

C 0081 

C OUTPUTS STRAIGHT RETURN WITH NO OUTPUTS IF LX OR MFREQ LSTHN 1 0082 

C 0083 

C X(I) I~l.* • LX IS THE INVERSE TRANSFORM DETERMINED AS FOLLOWS* 0084 

C LET Pl-3. 14159265 0085 

C M*MFREQ 0086 

C SU) » FTREAL( J+13 FOR J * 0, 1,.*.,M-1 0087 

C S(M) = FTREAL ( M+l 1/2 0088. 

C SiJ) = S(-J) FOR J * -1,-2, ...,-M 0089 

C AU) = FTIMAJ(J+1) FOR J * 0, l,*i.., M 0090 

C A(J) = -A(-J) FOR J * -1,-2, ...,-M 0091 

C 0092 

C THE TRAPEZOIDAL APPROXIMATION USED FOR COMPUTING XU) 0093 

C IS THEN GIVEN BY 0094 

C 0095 

C 1 M PI 0096 

C XU) = SUM ( SIJ) ♦ COSI J*( I-IXZER)*— — ) * 0097 

C 2*M J=-M M 0098 

C 0099 

C PI 0100 

C A(J) * SIN(J»( I-IXZER)* ►-•} i 0101 

C M 0102 

C 0103 

C FOR I * 1,2,.. .,LX 0104 

C 0105 

C EQUIVALENCES, FTREAL OR FT IMA J } IS PERMITTED 0106 

C 0107 

C IANS 0 NORMALLY 0108 

C = -1 MEANS ILLEGAL MFREQ 0109 

C * -2 MEANS ILLEGAL LX 0110 

C 0111 

C EXAMPLES 0112 

C 0113 

C 1. INPUTS - FTRd.j.5) = 8., 0., -4., 0.,-16. 0114 

C FTi(l.*.5> = 0., 0., 4., 0., 0. M=4 0115 

C USAGE - CALL QIFURY(FTR r FTI,M, 8, 1, SPACE, XI* IANS1J 0116 

C CALL QIFURY(FTR*FTI,M,16, 1, SPACE, X2* I ANS2) 0117 

C CALL OIFURY(FTR,FTI,M, 8, 2,SPACE,X3| IANS3J 0118 

C CALL QIFURYC FTR,FTI , M, 8,-5, SPACE, X4, IANS4) 0119 

C CALL QIFURYl FTR,FTI,M, 4, 27, SPACE, FTR, IANS5 Y 0120 

C CALL QIFURY ( FTR, FT 1 , 0, 8, 1, SPACE, X6,IANS6i 0121 

C CALL QIFURY(FTR,FTI,M,-1, 1, SPACE, X7, IA«S7f 0122 

C OUTPUTS - IANS1=IANS2=...=IANS5 = 0, IANS6 » -1 IANS7 = -2 0123 

C XHU.w8) » -2., 4., 0., 2., -2., 4., 0., 2. 0124 

C X2U...8) * XIU...8) AND X2 ( 9. . . 16 )*X i( 1. .. 8? 0125 

C X3U...8) » 2., -2., 4., 0., 2., -2., 4., 0. 0126 

C X4M...8) - 0., 2., -2., 4., 0., 2., -2., 4. 0127 

C FTRU.J.4) ^ 0., 2., -2., 4. 0128 

C 0129 

C 2. FOURIER TRANSFORM BY QFURRY WITH INVERSION BY QIFURY 0130 

C INPUTS - XU...8) = -2.,4.,0.,2.,-2.,4.,0.,2. 0131 

C USAGE - CALL QFURRYt X ,8, 1,4, 0, 4, SPACE, FTR 1 , FT 1 1 , IANS8) 0132 

C CALL QIFURY(FTR1,FTI1,4,8,1,SPACE,X5,IANS9) 0133 

C 0134 

C CALL QFURRY(X,8,1,6,0,6,SPACE,FTR2,FTI2,IANS101 0135 

C CALL QIFURY(FTR2, FTI2, 6, 11,1, SPACE, X6,IANSli} 0136 

C 0137 

C OUTPUTS - IANS8 * IANS9 * IANS10 = IANSll » 0 0138 

C X5(1...8) = -2.,4.,0.,2.,-2.,4.,0.,2. 0139 

C X6fl«..ll) = -2.,4.,0.,2.,-2.,4.,0.,2.,0.,0.,0* 0140 

C (NOTE WE NEED TO DIMENSION FTRK 5) ,FTI 1C 5) ,FTR2 (71 , 0141 

C FTI2(7) ) 0142 

C 0143 

C PROGRAM FOLLOWS BELOW 0144 

C 0145 

C DUMMY DIMENSIONS 0146 
DIMENSION SPACE(2),X(2),FTREAL(2),FTIMAJ(2) 0147 



C BRING IN AND TEST MFREQ , LX 0148 
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M«MFREQ 

NX=LX 

IANS=-l 

IF (M) 9999,9999,10 
10 IANS=-2 

IF (NX) 9999,9999,20 
C OK, END ADJUST FTREAL* ( THE ENDS OF FTIMAJ SHOULD BE ZEROI 
20 IANS*0 

FTREAL (1) S FTREAL(1) /2*0 

FTREAL(M+1)*FTREAL(M+1) /2.0 
C NOW COMPUTE THE TWO PARTS OF THE INVERSE TRANSFORM 
C INTO SPACE (1) AND SPACE <M + 2) WITH TABLES IN SPACE <2M*3) AND 
C SPACE (3M+4) 

ISANT=M+2 

ISCTAB=ISANT+M+1 

ISSTAB-ISCTAB+M+l 

CALL COSTBLIM, SPACE USCTAB)) 

CALL SINTBLC M, SPACE (ISSTAB)) 

CALL COSISP (FTREAL, FTREAL, FT I MA J, FT IMA J, M, SPACE ( ISCTAB) » 
1 SPACE ( ISSTAB) ,M,0,M, 1.0, SPACE ( 1), SPACE* ISANT ) 1 

C THE STARTING INDEX FOR XT IS XT( L )=XTI l-IXZER) • 
C WE HAVE TO FIND L AND PUT IT , INCREMENT ING BY 2M , IN THE 
C INCLUSIVE RANGE -M* 1 , -M+2 , . . * , 0, . . »M, THIS MODIFIED 
C VALUE OF L WILL BE CALLED INEXT. START 8Y MUDULO 2»M 

MDUBL-M+M 

L-1-IXZER 

INEXT * XMODF (L,MDUBL) 
C THE MOD FUNCTION PUTS INEXT IN -2M+1, • • . , 2M-1 
IF ( I NEXT— M ) 50,50,40 
40 INEXT*INEXT-MDUBL 

GO TO 70 
50 IF ( INEXT+M) 60,60,70 
60 INEXI^lNbXI-t-PiuUBL 
70 FM^FLOATF(M) 
C LOOP TO FORM XU...LX) 

DO 120 IX*1,NX 
C REDUCE INEXT BY 2*M WHENEVER IT INCREMENTS BEYOND M 
IF (INEXT-M) 90,90,80 
80 I NEXT= INEXT— MDUBL 
C INEXT IS NOW IN LEGAL RANGE 
90 MAGI=XABSF( INEXT) 
IANT=MAGI+ISANT 
TEMP= SPACEM ANT ) 
C REVERSE SIGN OF TEMP FOR NEGATIVE INEXT 
IF ( I NEXT) 100,110,110, 
100 TEMP= -TEMP 
C STORE X AND INCREMENT INEXT 
110 X(IX)« (SPACE(MAGI+1)+TEMP)/FM 

INEXT = INEXT+1 
120 CONTINUE 
C RESCALE FTREAL UNLESS IT IS EQUIVALENT TO X 

IF (XLOCF (FTREAL) - XLOCF(X)) 130,9999,130 
130 FTREAL ( 1 ) - FTREAL( 1) *2.0 

FTREAL (M+1)=*FTREAL(M+1)*2.0 

C EXIT 
9999 RETURN 
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• QINTR1 (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO* 0191 

• LABEL 0001 
CQINTR1 0002 

SUBROUTINE QINTR1 (X, XLO, DELX, TABLE, NTABLE, YOFX ) 0003 

C 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - QINTR1 0008 

C QUAORATIC INTERPOLATION IN A TABLE 0009 

C 0010 

C QINTR1 USES QUFIT1 TO INTERPOLATE FOR A VALUE, WHICH LIES 0011 

C AMONG THREE SUCCESSIVE TABULATED VALUES, BY FITTING A 0012 

C PARABOLA. LINEAR INTERPOLATION OCCURS IF THERI ARE ONLY 0013 

C TWO TABLE VALUES. XLO IS THE ARGUMENT CORRESPONDING TO 0014 

C THE LOWEST TABLE VALUE. DELX IS THE ARGUMENT DIFFERENCE 0015 

C BETWEEN TABLE VALUES. THE FORMULA 0016 

C 0017 

C YOFX = C0EFS(1)+C0EFS*2)«XREL+C0EFS{3)*XREL#*2 OOIQ 

C 0019 

C IS USED TO FIND THE INTERPOLATED VALUE, WHERE 0020 

C YOFX IS THE INTERPOLATED VALUE, 0021 

C C0EFSU...3) ARE COEFFICIENTS COMPUTED BY QUFIT1, 0022 

C BASED ON THREE TABLE VALUES CHOSEN BY QINTR1 * 0023 

C XREL IS A FRACTIONAL ARGUMENT VALUE RELATIVE TO 0024 

C THE MIDDLE CHOSEN TABLE VALUE. 0025 

C 0026 

C 0027 

C LANGUAGE - FORTRAN II SUBROUTINE 0028 

C EQUIPMENT - 709/7090/7094 (MAIN FRAME ONLY) 0029 

C STORAGE - 229 REGISTERS 0030 

C SPEED - ABOUT .6 TO .7 MILLISECONDS ON THE 7094 . 0031 

C AUTHOR - J. PROGITO, MAY 1964 0032 

C 0033 

C 0034 

C USAGE 0035 

C 0036 

C TRANSFER VECTOR CONTAINS ROUTINES - RNDUP, QUFIT1 0037 

C AND FORTRAN SYSTEM ROUTINES - INOT ANY) 0038 

C 0039 

C FORTRAN USAGE 0040 

C CALL QINTR1(X,XL0, DELX, TABLE, NTABLE, YOFX) 0041 

C 0042 

C 0043 

C INPUTS 0044 

C 0045 

C X IS THE ARGUMENT FOR WHICH INTERPOLATION IS DESIRED 0046 

C SHOULD BE GRTHN- XLO AND LSTHN= XL0-MNTABLE-1)*DELX 0047 

C 0048 

C XLO IS THE ARGUMENT CORRESPONDING TO THE FIRST TABLE ENTRY 0049 

C 0050 

C DELX IS THE ARGUMENT DIFFERENCE BETWEEN TABLE ENTRIfS 0051 

C MUST EXCEED ZERO 0052 

C 0053 

C TABLE ( I ) 1=1.*. NTABLE IS THE TABLE OF VALUES TO BE USED FOR 0054 

C INTERPOLATING 0055 

C 0056 

C NTABLE IS LENGTH OF TABLE 0057 

C MUST BE GRTHN= 2 0058 

C 0059 

C 0060 

C OUTPUTS STRAIGHT RETURN IF DELX OR NTABLE ILLEGAL. 0061 

C 0062 

C YOFX THE INTERPOLATED VALUE DESIRED CORRESPONDING TO X. 0063 

C EXCEPT = 0.0 IF X IS ILLEGAL. 0064 

C 0065 

C 0066 

C EXAMPLES 0067 

C 0068 

C 1. INPUTS - TABLE ( 1) * 1. NTABLE=1 X=2. XLO=0. DELX^l. Y0FX*-99. 0069 

C OUTPUTS - Y0FX=-99. 0070 

C 0071 

C 2. INPUTS - TABLEU...2) = 0.,12. NTABLE=2 X*l.5 XL0=1. DELX*!. 0072 

C OUTPUTS - Y0FX*6.0 0073 

C 0074 
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PROGRAM LISTINGS 



C 3. 


INPUTS 


- 


TABLEU...3) = 0.,6.,12. NTABLE=3 X=2.333 X£0*l. 


r* 

V. 






net v — 1 
UCLA- 1 • 


C 

c 


OUTPUTS 


- 


YOFX*8. 


r l. 


T WP| ITC 

1 INrU 1 5 




TAQI C ( 1 A 1 — H A 1 O 10 KIT A (31 C<- A Y— Tl VI T 
1 AOLC I 1 • • • H J — U • , O . , 1 A. , J. O, NIAOLC 36 ** A = Cm O ALU* 8 !* 








DELX = 1 • 


C 
C 


OUTPUTS 




YOFX=7.8 




T KlDl ITC 




CAMC AC CYAMDI C A CY1~CDT V — O Q 
oAHfc Ai tAArlrLlr *»■• CAttr 1 A = A • O 


C 

c 


OUTPUTS 




Y0FX=10.8 


C A 


1 INK U 1 5 




T»oi CM A % — n '5'3'11AAA~7ir\ V » 1 A DCCT 4 CV /. 

lABLtl I...HJ - U.f J» J33»6»OOf » 1U« A*i«H Ktol * cXn 4« 


c 

C 


OUTPUTS 


- 


YOFX=1.3333 


r 7 


TMDIITC 




IAdLcIU««o)« Utj J.JJjf o. coo (i lu • , 13* 3 33 1 lo.oor,£u. ,23. 33 


c 






NTABLF*8 X=6.7 XL0=1. DELX*2. 


C 


OUTPUTS 


- 


Y0FX=9.5 


Q 

C 8. 


INPUTS 


- 


SAME AS EXAMPLE 7, EXCEPT X=4. 


C 


OUTPUTS 


— 


Y0FX=5.0 


C 9. 


INPUTS 




SAME AS EXAMPLE 7. EXCEPT X=0. 


C 
C 


OUTPUTS 




YOFX=0. 


CIO. 


INPUTS 




SAME AS EXAMPLE 7. EXCEPT X=7. 


c 
c 


OUTPUTS 




YOFX^IO.O 


Cll. 


INPUTS 




SAME AS EXAMPLE 7, EXCEPT DELX=1* X=4. 


c 
c 


OUTPUTS 




YOFX^IO.O 


C12. 


INPUTS 




SAME AS EXAMPLE 11. EXCEPT XL0=2. 


C OUTPUTS - Y0FX=6.6667 


\* 

C13. 


INPUTS 




SAME AS EXAMPLE 12. EXCEPT X=2.3 


C 
C 


OUTPUTS 




Y0FX=1.0 


C14. 


INPUTS 




SAME AS EXAMPLE 12. EXCEPT X«2.8 


C 
C 


OUTPUTS 




YOFX-2.666 


C15. 


INPUTS 




SAME AS EXAMPLE 12. EXCEPT X = 1.4 


C 


OUTPUTS 




YOFX*0. 



C PROGRAM FOLLOWS BELOW 
C 

DIMENSION TABLE(3),C0EFS(3) 

C 

C CHECK FOR ILLEGAL NTABLE, DELX. 
C 

IF ( NTABLE- 1 ) 9991,9991,1 

1 IF (DELX) 9991,9991,2 

2 IF (X-XLO) 999*5,5 

C 

C COMPUTE ILO,IHI,XREL tXREL= X VALUE RELATIVE TO ILO, IHI ) 
C 

5 XRELM X-XLO) /DELX + 1. 
ILO*XREL 

IHI* RNDUPF { XREL ) 

IF (IHI-NTABLE) 7,7,999 

C 

C BEGIN CHECKS FOR UPPER AND LOWER LIMITS. 
C 

7 IF (IHI-ILO) 9991,200,10 
10 IF (ILO-l) 999,20,40 

C 

C ILO - 1 . NOW BRANCH ON TABLE LENGTH. 
C 

20 IF (NTABLE-2) 9991,30,50 

C 

C NTABLE » 2. SINCE THERE ARE ONLY 2 POINTS, INTERPOLATE LINEARLY, EXIT. 
C 

30 YOFX-TABLEi 1 ) ♦( C X-XLO) *(TABLEC2)-TABLE( ID) /DELX 
GO TO 9991 

C 

C ILO GRTHN 1, NOW CHECK IHI. 
C 
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0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 

r\t m 

0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
.0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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40 


IF (IHI-NTABLE) 70,60,999 




0150 


C 






0151 


C NTABLE IS GRTHN 2 AND ILO * 1, SO SET IMID = 2 AND FIT PARABOLA 


0152 


c 






0153 


50 


IMID=2 




0154 




GO TO 90 




0155 


c 






0156 


C IHl 


= NTABLE, ILO GRTHN 1, SO IMID » NTABLE- 1 




0157 


C 






0158 


60 


IMID=NTABLE-1 




0159 




GO TO 90 




0160 


C 






0161 


C TES 


T FRACTIONAL PART OF X VALUE AND FINO OUT WHETHER 


IT IS GLOSER TO 


0162 


C 


ILO OR IHI. SET IMID * TO THE INDEX THE VALUE IS 


CLOSEST JQm 


0163 


C 






0164 


70 


XFRAC=XREL-FLOATF( ILO) 




0165 




IF <XFRAC-.5) 75,80,80 




0166 


75 


IMID=ILO 




0167 




GO TO 90 




0168 


80 


IMID^IHI 




0169 


C 






0170 


C FIND COEFFICIENTS FOR EQUATION 




0171 


C 






0172 


90 


CALL QUFITltTABLEC IMID-1 ),-!., 1., COEFS) 




0173 


C 






0174 


C COMPUTE YOFX WITH COEFS AND XREL 




0175 


C 






0176 




XREL=XREL— FLOATF ( IMID) 




0177 




YOFX=COEFS< l)+CGEFS<2)*XREL+C0EFSm*XR£L*XREL 




0178 




GO TO 9991 




0179 


c 






0180 


C IF 


ILO=IHI YOFX^TABLEC ILO) 




0181 


C 






0182 


200 


IF ( ILO— NTABLE ) 300,300,999 




0183 


300 


YOFX = TABLE ( I LO ) 




0184 




GO TO 9991 




0185 


C 






0186 


C ALL 


X VALUES OUT OF TABLE RANGE *0<.0 




0187 


C 






0188 


999 


YOFX=0,0 




0189 


9991 


RETURN 




0190 




END 




0191 
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* QUFITl (SUBROUTINE! 9/4/64 LAST CARD IN DECK IS NO. 0199 

* FAP 0001 
•QUFITl 0002 

COUNT 200 0003 

LBL QUFITl 0004 

ENTRY QUFITl f FOFX, XLO, DELX, COEFS ) 0005 

» 0006 

* 0007 

* * ABSTRACT 0008 

* 0009 
» TITLE - QUFITl 0010 

* FIND QUADRATIC WHICH EXACTLY FITS 3 EQUALLY SPACED POINTS 0011 
» 0012 

* QUFITl FINDS C0,C1, AND C2 SUCH THAT THE QUADRATIC 0013 
» POLYNOMIAL 0014 
» 2 0015 
» F(X) * C0+C1*X+C2*X 0016 

* 0017 

* TAKES ON SPECIFIED VALUES AT X^XLO, XLO+DELX, AND 0018 

* XL0+2*DELX, WHERE XLO AND DELX ARE PARAMETERS. 0019 

* 0020 
« QUFITl HAS A HIGH SPEED AUTOMATIC BYPASS FOR THE CASE 0021 
« THAT XL0=-1.0 AND DELX=1.0 0022 

* 0023 
» LANGUAGE - FAP SUBROUTINE ( FORTRAN"- 1 1 COMPATIBLE) 0024 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0025 

* STORAGE - 79 REGISTERS 0026 

* SPEED - ABOUT 250 MACHINE CYCLES IN GENERAL (ON THE 70901 0027 
» 79 MACHINE CYCLES IF XL0=~1.0, AND DELX=*1*0 0028 
» AUTHOR - S.M.SIMPSON, MARCH 1964 0029 

* 0030 

* 0031 

* USAGE 0032 

* 0033 

* TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0034 

* AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0035 
» 0036 

* FORTRAN USAGE 0037 

* CALL QUF I Tl C FOFX , XLO, DELX , COEFS ) 0038 
» 0039 
» 0040 
» INPUTS 0041 
« 0042 
» FOFX(I) 1=1,2,3 ARE THE VALUES WHICH THE POLYNOMIAL MUST ASSUME* 0043 
« 0044 

* XLO IS STARTING VALUE OF ARGUMENT X. 0045 

* 0046 

* DELX IS ARGUMENT INCREMENT. 0047 

* IF DELX^O.O QUFITl COMPUTES AND EXITS AS THOUGH 0048 

* USER HAD SPECIFIED XLO=~1.0 (THE ACTUAL XLO IS NOT 0049 
» USED) AND DELX^l.O . THIS CASE TAKES 79 MACHINE 0050 
» CYCLES. IF DELX AND XLO ARE ACTUALLY SP8CIFIED TO 0051 

* BE 1.0 AND -1.0 RESPECTIVELY, ABOUT 91 MACHINE 0052 

* CYCLES ARE TAKEN. 0053 
» 0054 

* 0055 
» OUTPUTS 0056 

* 0057 

* COEFS(I) 1*1,2,3 WILL CONTAIN CO, CI, AND C2, RESPECTI Vf LY^ SUCH 0058 

* THAT THE POLYNOMIAL F(X) GIVEN IN THE AB ST PACT WILL 0059 
» SATISFY 0060 

* F(XLO) = FOFX(l) 0061 
« FULO+DELX) * F0FX(2) 0062 
» F(XL0+2*DELX) * F0FX(3) 0063 
« 0064 
» 0065 
« EXAMPLES 0066 

* 0067 
« 1. INPUTS - F0FX(1*..3) * 2.0,3.0,6.0 XL0=-1.0, DELX=1.0 0068 
» USAGE - CALL QUF IT1 ( FOFX , XLO, DELX, C0EFS1 ) 0069 

* CALL QUFIT1(FOFX,3.0, 0.0,COEFS2) 0070 

* OUTPUTS - C0EFSK1...3) * C0EFS2 ( 1 ... 3 ) » 3.0,2.0,1.0 0071 
» 0072 

* 2. INPUTS - F0FXU.I..3) * 3.0,3.0,11.0 XL0~-2.0, DELX=2.0 0073 

* USAGE - CALL QUFITl ( FOFX, XLO, DELX, C0EFS3 ) 0074 
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• OUTPUTS 


- C0EFS311..43) * 3,0,2.0,1.0 


0075 


• 




0076 


» 3. INPUTS 


- F0FXU...3) * 1.0,2.0,3.0 XL0=1.0, OELX=i.O 


0077 


• USAGE 


CALL QUFIT1(F0FX,XLG,DELX,C0EFS4) 


0078 


• OUTPUTS 


- C0EFS411...3) * 0.0,1.0,0.0 


0079 


• 




0080 


• 




0081 


• PROGRAM FOLLOWS BELOW 


0082 


* 




0083 


• 




0084 


» NO TRANSFER 


: VECTOR 


0085 


* 




0086 


HTR 


0 XR4 


0087 


BCI 


1, QUFITl 


0088 


* 




0089 


« ONLY ENTRY. 


QUFITHFOFX,XLO,DELX,COEFS> 


0090 


• 




0091 


QUFITl SXO 


QUFITl-2,4 


0092 


CLA 


1,4 A(FOFX) 


0093 


SUB 


Kl 


0094 


STA 


CLAF2 


0095 


SUB 


Kl 


0096 


STA 


CLAF3 


0097 


CLA 


4,4 A(COEFS) 


0098 


SUB 


Kl 


0099 


STA 


ST0C1 


0100 


SUB 


Kl 


0101 


STA 


ST0C2 


0102 


• 




0103 


* TRIAL SETTINGS 


0104 


* 




0105 


* COEFSU) « 


CO * F0FX(2). AND FORM 2C0 . 


0106 


• 




0107 


CLAF2 CLA 


** **=A(F0FX)-1 


0108 


STO* 


4,4 


0109 


TMI 


*+3 


01 1 0 


ADO 


KDUBL 


Olll 


TRA 


*+2 


0112 


SUB 


KDUBL 


0113 


STO 


TWOCZ 


0114 


* 




0115 


* C0EFS(2) * 


CI * (F0FX(3)-F0FX(l))/2.0 


0116 


* 




0117 


CLAF3 CLA 


** *»=A(F0FX>-2 


0118 


FSB* 


lt4 


0119 


TMI 


*+3 


0120 


SUB 


KDUBL 


0121 


TRA 


*+2 


0122 


AOO 


KDUBL 


0123 


STOC1 STO 


** **=A(COEFS)-l 


0124 


* 




0125 


• COEFSC3) * 


C2 = <FOFX<3)-2*FOFX(2)+FOFX< 1} )/2.0 


0126 


» 




0127 


CLA» 


CLAF3 


0128 


FSB 


TWOCZ 


0129 


FAO* 


1,4 


0130 


TMI 


*+3 


0131 


SUB 


KDUBL 


0132 


TRA 


*+2 


0133 


AOO 


KDUBL 


0134 


STOC2 STO 


** ***A(C0EFS)-2 


0135 


• 




0136 


* QUIT IF DELX=0 


0137 


• 




0138 


CLA* 


3,4 


0139 


TZE 


5,4 


0140 


• 




0141 


* ALL DONE IF 


DELX=l.O AND XL0=-1.0 


0142 


• 




0143 


CAS 


K1L 


0144 


TRA 


REVISE FAIL 


0145 


TRA 


*+2 MAYBE 


0146 


TRA 


REVISE FAIL 


0147 


CLS* 


2,4 XLO CHECK 


0148 


CAS 


K1L 


0149 
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TRA 


REVISE 




nt «;n 

U 1 !>U 


TRA 


5,4 




EXIT 


u i-:> i 


• 










• FOR REVISION SET G 


■ -(XL0/DELX + 1) 


Ul!)i 


* ANO 












r n — 


(G**2)*C2+G*Cl+C0 


Ul D!> 


* 


L 1 — 


(2*G*C2 


+CD/DELX 


0156 






C2/(DELX»*2) 


U I 3 f 










ni f>A 


KCVlot OLA* 










CTn 


L^ 




i ni it trtnci 
I PU I AS I Ufc ) 


ni An 

U lOU 


rUr* 


3 A 




Lc./ UCLA 


n i a i 


AL- A 








n i a o 
u loZ 


rUr* 


3 f ** 




/DELX AGAIN 


Alii 

U ID 3 


o 1 y* 


ST0C2 




= C2 


n i a a 


I.LA* 


o 1 UL- 1 








c rn 
5 1 u 


r i 






ni aa 
U 1 oo 


LLb* 


2,4 




— vi n 

""ALU 


ni at 

Ul O f 


FDP» 


3,4 




""ALU/ UCLA 


m aa 
ui oo 


XCA 








m aq 

UloV 


r JO 


ki i 

IV J. L 




~l aLU/UCLAtI.U) 


ni 7n 
U 1 f u 


STO 


Q 






0171 


FAD 


G 




">C 


0172 


XCA 








0173 


FMP 


C2 






0174 


PAH 


r i 
l i 






0175 


FOP* 


3,4 






0 1 76 


C.TO* 


ST0C1 






0177 




C? 






0178 


FMP 


G 






ni 7Q 

Ul (7 


r AU 


CI 






U 1 o u 


Vf A 

AU A 








0181 










/"\ 1 o -» 


c An* 
r au* 


4,4 






Ul O J 


c to* 

5 1 U* 


4,4 






m da 

U 1 OH 


* 








ai oe 
Ul Oj 


» EXIT 








ni ft a 

U 1 OO 


• 








Ul or 


TRA 


5,4 






U 1 OO 


• 








0189 


* CONSTANTS* 


TEMPORARIES 




0190 


» 








0191 


Kl PZE 


i 






0192 


K1L DEC 


1.0 






0193 


KDUBL OCT 


001000000000 




0194 


TWOCZ PZE 


*• 9 *♦ 


f *» 


2*C0 


0195 


G PZE 


** f *« 


,## 


-UL0/DELX + 1) 


0196 


C2 PZE 


** f *» 


,#* 


TRIAL C2 


0197 


CI PZE 


*#, *• 


,#* 


TRIAL CI 


0198 


END 








0199 
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QXCORR i SUBROUTINE ) 9/29/64 LAST CARD IN DECK IS NO. 0248 

LABEL 0G01 



CQXCORR 0002 
SUBROUTINE QXCORR <X,Y,LXY, MXACC, MXLAG, SPACE, XCOR, IANS ) 0003 

C 0004 

C ——ABSTRACT 0005 

C 0006 

C TITLE - QXCORR 0007 

C FAST CROSS-CORRELATIONS FOR LONG, LIMITED ACCURACY SERIES 0008 

C 0009 

C QXCORR COMPUTES THE UNNORMALIZED CROSS-CORRELAT tON 0010 

C FUNCTION, XC(L), OF TWO LIMITED ACCURACY SERIES* X(I3 0011 

C AND YU) BOTH OF LENGTH LXY, ACCORDING TO THE TRANSIENT 0012 

C FORMULA 0013 

C 0014 

C 1 LXY 0015 

C XCCL) — * SUM i Xm*Y(H»L) ) 0016 

C LXY 1=1 0017 

C 0018 

C FOR L = -MXLAG, -MXLAG4l,*..,-l,0,l,...,MXLAG 0019 

C 0020 

C WHERE Y(K) IS ASSUMED = 0.0 WHENEVER K IS 0021 

C OUTSIDE OF THE RANGE 1 TO LXY 0022 

C MXLAG AND LXY ARE INPUT PARAMETERS 0023 

C 0024 

C SPEED IS CONTROLLED BY THE SERIES LENGTH AND THS 0025 

C SERIES ACCURACY. FOR VERY LONG SERIES A COMPLETE CROSS- 0026 

C CORRELATION (MXLAG = LXY-1) CAN BE COMPUTED IN SLIGHTLY 0027 

C MORE THAN 2* ( LXY ( SQUARED I ) MACHINE CYCLES. QXCORR OBTAINS 0028 

C THIS SPEED PRIMARILY BY CONVERTING XII) AND Y!I) TO 0029 

C INTEGER SEQUENCES IX(I) AND IYU) WHOSE MAGNITUDES HAVE 0030 

C UPPER LIMIT AS SPECIFIED BY AN INPUT PARAMETER MXACC, AND 0031 

C THEN REGROUPS THE ABOVE EQUATION (FOR EACH LAG) SO AS TO 0032 

C PERFORM 2*(LXY-L)-1 ADDITIONS PLUS MXACC (OR FEWER) MULTf- 0033 

C PLICATIONS (RATHER THAN 2»(LXY-L)-1 ADDITIONS PLUS 0034 

C 2*(LXY-L)-l MULTIPLICATIONS). (SEE SUBROUTINE PROCOR— FA5C0R 0035 

C FOR LOGIC DETAILS.) THE RESULTS ARE THEN RECONVERTED TO 0036 

C FLOATING POINT FORM WITH CORRECT SCALE. I X 1 1 3 AND IYU) 0037 

C ARE ALSO REFLOATED. 0038 

C 0039 

C USER MUST PROVIDE QXCORR WITH A BLOCK OF TEMPORARY 0040 

C REGISTERS OF LENGTH LXY + 10*(MXACC+1) + 1 . 0041 

C 0042 

C XU) AND Y(I) ARE LEFT SLIGHTLY MODIFIED BY THE FIXING, 0043 

C REFLOATING PROCESS 0044 

C 0045 

C IF QXCORR DETECTS THAT THE X AND Y SERIES ARE THE SAME 0046 

C IT COMPUTES AND STORES XC1L) ONLY FOR POSITIVE LAGS SO 0047 

C THAT QXCORR CAN BE USED FOR EFFICIENT AUTOCORRELATIONS 0048 

C AS WELL AS CROSS-CORRELATIONS. 0049 

C 0050 

C LANGUAGE - FORTRAN II SUBROUTINE 0051 

C EQUIPMENT -* IBM 709,1 7090 (MAIN FRAME ONLY) 0052 

C STORAGE - 283 REGISTERS 0053 

C SPEED - FOR LONG SERIES QXCORR TAKES ABOUT 0054 

C (2*MXLAG+1)*(2*LX-MXLAG+20»MXACC) MACHINE CYCLES 0055 

C (DIVIDE THIS BY 2 IF X AND Y ARE EQUIVALENT) 0056 

C AUTHOR - S. M. SIMPSON JR, 10/10/62 0057 

C 0058 

C USAGE 0059 

C 0060 

C TRANSFER VECTOR CONTAINS ROUTINES - FXDATA, PROCOR, FASCOR, FLDATA 0061 

C AND FORTRAN SYSTEM ROUTINES - XLOC 0062 

C 0063 

C FORTRAN USAGE 0064 

C CALL QXCORRIX,Y,LXY, MXACC, MXLAG,SPACE,XCOR, IANS) 0065 

C 0066 

C INPUTS 0067 

C 0068 

C X ( I ) 1*1. • .LXY IS THE FIRST SERIES 0069 

C 0070 

C Y(I) 1=1.. .LXY IS THE SECOND SERIES 0071 

C EQUIVALENCE (X,Y) IS PERMITTED (GIVING AUTO COREL.) 0072 

C NO OTHER OVERLAP OF X AND Y IS PERMITTED 0073 

C 0074 
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LXY 
MXACC 



MXLAG 
SPACE (I) 

OUTPUTS 
X(I) 



Yd) 



XCORU) 



C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

C EXAMPLES 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 

C 2 



IANS 



MUST EXCEED ZERO AND BE LSTHN* lOOOO 



DEFINES ACCURACY OF THE TWO SERIES. X( I ) AND YCI1 WILL 
BE FIXED SO AS TO HAVE VALUES LYING BETWEEN -MXACC 
AND +MXACC INCLUSIVE. 

MUST LIE BETWEEN 1 AND 1000 INCLUSIVE. ( SMALLER VALUES 
YIELD HIGHER SPEEDS AND REQUIRE FEWER TEMPORARIES* I 

IS THE HIGHEST LAG NO. DESIRED IN THE CROSS-CORRELATION 

I=I.*.LSPACE MUST BE AVAILABLE AS TEMPORARIES, WHERE 
LSPACE = LX ♦ 10»<MXACC*1) + 1 



1 = 1.. . LXY CONTAINS THE ROUNDED SERIES XXU) 



XX(I) 

WHERE 

IX ( I ) 
SCALEX 
XMAX 

X(I ) IS LEFT * 



* FLOATF(IX(I))/SCALEX 

» XFIXF(X(I)»SCALEX) 
= FLOATF(MXACC)/XMAX 

* LARGEST X MAGNITUDE 
0.0 IF XMAX * 0.0 



1*1. ..LXY CONTAINS THE ROUNDED SERIES YYU) 



YY(I) 

WHERE 

IY(I) 
SCALEY 
YMAX 

Y(I) IS LEFT * 



= FLOATFUYIin/SCALEY 



XFIXFI Y< I )*SCALEY ) 
F LO AT F( MXACC ) /YMAX 
LARGEST Y MAGNITUDE 
0 IF YMAX » 0.0 
(NOTE- XFIXF IN ABOVE EXPRESSIONS IMPLIES ROUNDING 
TO NEAREST INTEGER, NOT TRUNCATION) 



I*lt..# CONTAINS THE CORRELATION FUNCTION 

IF X AND Y ARE DIFFERENT SERIES 

XC0R!l t 2t...»2*MXLAG+ 1) CONTAINS THE CROSS- 
CORRELATION FUNCTION FROM NEGATIVE TO POSITIVE LAGS 

AS COMPUTED ON THE ROUNDED SERIES 

I*E. XCOR(I) = XC( I-1-MXLAG) I«l , . ; . , 2*MXLAG*1 
WHERE 

1 LXY 

XC(L) » * SUM ( XX(I)»YY(I+L) J 

LXY 1=1 

FOR L = -MXLAG? -MX LAG* It *• .tMXLAG 
AND YY(K) ASSUMED = 0.0 WHENEVER K IS OUTSIDE 
THE RANGE 1 TO LXY 
IF X AND Y ARE EQUIVALENT ( XLOCFI X ) 5 =XLOCF( Y) ) 

XC0R(1,2»...,MXLAG+1) CONTAINS THE AUTOCORRELATION 
FUNCTION FROM LAG ZERO TO LAG MXLAG 
I.E. XCOR(I) » XC(I-l) I » l,... f MXLAG*l 
XCORU) WILL BE IDENTICALLY ZERO IF X( I) OR Y(l) ISJ 

0 IF NO TROUBLE ARISES 

58 -2 IF Y PARTIALLY OVERLAPS X 

* -3 IF LXY IS ILLEGAL 

* -4 IF MXACC IS ILLEGAL 

* -5 IF MXLAG IS ILLEGAL 

» -98 IF UNEXPLAINED ERROR RETURN FROM PROCOR OCCURS 

* -99 IF UNEXPLAINED ERROR RETURN FROM FASCOR OCCURS 

THE FIRST 4 EXAMPLES ARE CHOSEN SO THAT THE ROUNDOFF 
EFFECT IS NOT PRESENT 

CALL QXCORR (X? Y f LXY f MXACC y MXLAG* SPACEt XCOR# IANS) IS 

THE ASSUMED USAGE IN ALL EXAMPLES UNLESS 0THER1II5E STATED 



1. COMPLETE 
INPUTS 



CROSS CORRELATION 
- X(1.4.5) * 10. ,20., 10., 10. »5. 
LXY=5 MXACC»20 MXLAG-4 
OUTPUTS - Xd.*.5) AND Yd. ..5) » INPUT VALUES 

XCORC 1.. .9)=!., 3., 5. ,9. ,11. ,10. ,8. ,6., 2 



Y( n..5)=l.,l.,l.,l.,l. 

IANS*0 



PARTIAL 
INPUTS 



CROSS-CORRELATION 

- SAME AS EXAMPLE 1 EXCEPT MXLAG=2 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 

0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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C OUTPUTS - f SAME AS EXAMPLE I EXCEPT XCOR( 1. . . 5) = 5. , 9. 41 1. 4 10. , 8* C150 

C 0151 

C 3. CORRELATION BEYOND END OF SERIES 0152 

C INPUTS - SAME AS EXAMPLE 1 EXCEPT MXLAG*6 0153 

C OUTPUTS - SAME AS EXAMPLE 1 EXCEPT TERMINAL ZEROES ADDED TO XCOR 0154 
C IE XCORC 1...13)«0.,0.,1.,3., 5., 9., 1 1. , 10. *8. ,6. |2. #0. tO. 0155 

C 0156 

C4. COMPLETE AUTOCORRELATION 0157 

C INPUTS - SAME AS EXAMPLE 1 0158 

C USAGE - CALL QXCORR ( X, X, LXY, MXACC, MXLAG, SPACE, XC0R, CANS) 0159 

C OUTPUTS - SAME AS EXAMPLE 1 EXCEPT 0160 

C XC0RIU..5) * 145., 110. ,70. ,40. ,10. 0161 

C 0162 

C 5. COMPLETE CROSS-CORRELATION SHOWING ROUNDOFF 0163 

C INPUTS - X(1...3)=23.8,148.0,20.3 Yl i...3)*l. , 1., 1. 0164 

C LXY=3 MXACC=100 MXLAG-2 0165 

C OUTPUTS - X(1...3)*23.68,148.0,20.72 Y(1...3)=l. , 1., 1. IANS*0 0166 

C XCORU... 5)^6.90667,56. 2400, 64. 1333, 57. 2267, 7. 8933 0167 

C 0168 

C 6. THE NEXT FOUR EXAMPLES SHOW ERROR CONDITIONS 0169 

C INPUTS - SAME AS EXAMPLE 1 0170 
C USAGE - CALL QXCORRt X ,X< 2 > , LXY,MXACC, MXL AG, SPACER XCOR 4 I ANSI 0171 
C OR CALL QXC0RR(X(2),X,LXY,MXACC, MXLAG, SPACE,XCOR,IANSJ 0172 

C OUTPUTS - IANS * -2 (X AND Y PARTIALLY OVERLAP) 0173 

C 0174 

C 7. INPUTS - SAME AS EXAMPLE 1 EXCEPT LXY=0 0175 

C OUTPUTS - IANS*-3 (ILLEGAL LXY) 0176 

C 0177 

C 8. INPUTS - SAME AS EXAMPLE 1 EXCEPT MXACC=1500 0178 

C OUTPUTS - IANS=-4 (ILLEGAL MXACC) 0179 

C 0180 

C 9. INPUTS - SAME AS EXAMPLE 1 EXCEPT MXLAG=-2 0181 

C OUTPUTS - IANS*-5 (ILLEGAL MXLAG) 0182 

C 0183 

CIO. (SPECIAL TEST FOR BYPASS ON X(I) ALL ZERO) 0184 

C INPUTS - SAME AS EXAMPLE 1 EXCEPT XI U..5)=0. f 0., .. .* 0185 

C OUTPUTS - XC0R(1...9)*0.,0.,... 0186 

C 0187 

Cll. INPUTS - SAME AS EXAMPLE 1 EXCEPT Y(1...5) s 0.,0.,..«l 0188 

C OUTPUTS - XC0RIU..9)*0..0.,... 0189 

C 0190 

C PROGRAM FOLLOWS BELOW 0191 

C 0192 

DIMENSION XC2) , Y (2 ) , SPACE( 2 ) ,XC0R<2) 0193 

C CHECK INPUTS 0194 

IANS=-3 0195 

IF (LXY) 9999,9999,5 0196 

5 IF (LXY-100G0) 10,10,9999 0197 

10 I ANS=-4 0198 

IF (MXACC) 9999,9999,20 0199 

20 IF (MXACC-1000) 30,30,9999 0200 

30 I ANS=— 5 0201 

IF (MXLAG) 9999,40,40 0202 

C SET ACTUAL NO. OF LAGS TO BE COMPUTED 0203 

40 NLAGS = XMIN0F(MXLAG,LXY-1) 0204 

C SET SWITCH a 0 FOR CASE X EQUIV Y AND CHECK PARTIAL OVERLAP 0205 

I ANS=-2 0206 

IDIFF = XABSFfXLOCF(X)-XLOCF(Y) ) 0207 

IF (IDIFF) 55,55,52 0208 

52 IF ( ID IFF— LXY) 9999,60,60 0209 

C SET FOR X AND Y EQUIVALENT 0210 

55 NCORS = MXLAG+1 0211 

KSTORE = 1 0212 

LMIN » 0 0213 

GO TO 65 0214 

C SET FOR X AND Y DIFFERENT 0215 

60 NCORS * 2»MXLAG*1 0216 

KSTORE = MXLAG+1 0217 

LMIN * -NLAGS 0218 

C CLEAR OUTPUT AREA 0219 

65 DO 66 1=1, NCORS 0220 

66 XCOR(I) * 0.0 0221 
C SET SPACE CONSTANT FOR PROCOR AND FIX X A.MO Y. EXIT FOR ZERO VECTORS. 0222 

70 LSPACE=LXY+10«(MXACC+1)+1 0223 

IANS=0 0224 
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CALL FXDATAf LXY#X, MX ACC, SCALEX) 0225 

IF (SCALEX) 9999,9999,80 0226 

80 SCALEY^SCALEX 0227 

IF (IDIFF) 85,90,85 0228 

85 CALL F XD ATA CLXY*Y, MX ACC, SCALEY) 0229 

IF (SCALEY) 900,900,90 0230 

C COMPUTE CROSS CORRELATION 0231 

90 I ANS=-98 0232 

CALL PROCOR(X,LXY,MXACC,SPACEUSPACE),SPACEI I), ANSR) 0233 

IF (ANSR) 900,100,900 0234 

100 IANS=-99 0235 

CALL FASCORl Y,LMIN,NL AGS, XCOR(KSTORE), ANSR) 0236 

IF (ANSR) 900,120,900 0237 

C NOW FLOAT AND SCALE XCOR 0238 

120 IANS=0 0239 

SCXC=SCALEX#SCALEY*FLOATF(LXY) 0240 

CALL FLOATA<NCORS,XCOR,SCXC) 0241 

C REFLOAT X AND Y 0242 

900 CALL FLDATA(LXY,X, SCALEX) 0243 

IF (IDIFF) 905,9999,905 0244 

905 CALL FLDATACLXY,Y, SCALEY) 0245 

C EXIT 0246 

9999 RETURN 0247 

END 0248 
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* QXCORl (SUBROUTINE) 3/15/65 LAST CARD IN DECK IS NO. 0197 

* LABEL 0001 
CQXC0R1 0002 

SUBROUTINE QXCORl (LXX, XX,LYY, YY,MXACC , I LAG, NLAGS, CORR, IAD, 0003 

1 L SPACE, SPACE, IANS) 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - QXCORl 0008 

C QUICK CROSSCORRELATION OF ML I TRANSIENTS 0009 

C 0010 

C QXCORl FINOS THE CROSSCORRELATION OF TWO ML I (MACHINE 0011 

C LANGUAGE INTEGER) TRANSIENTS X(I) 1=1,... ,LX Y(J) 0012 

C J*1,...,LY ACCORDING TO THE FORMULA 0013 

C M 0014 

C C(L) » SUM ( XU+L) « Y(I) ) 0015 

C I=-M 0016 

C 0017 

C FOR L * I LAG , . • • , I LAG+NLAGS-1 0018 

C WHERE 0019 

C MIS GRTHN LX ♦ LY (X(I) AND Yd) ARE ASSUMED TO 0020 

C BE ZERO OUTSIDE THE LIMITS OF THEIR DEFINITION) 0021 

C LX,LY, ILAG, AND NLAGS ARE INPUT PARAMETERS 0022 

C ADDITION INTO THE OUTPUT AREA IS MAOE AT THE 0023 

C OPERATORS DISCRETION. 0024 

C 0025 

C QXCORl OBTAINS ITS SPEED BY OPERATING SUBROUTINES PROCOR, 0026 

C FASCRl, AND FASEP1 ON THE INPUT SERIES. 0027 

C 0028 

C LANGUAGE - FORTRAN II SUBROUTINE 0029 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0030 

C STORAGE - 502 REGISTERS 0031 

C SPEED - CASE 1. WHEN ONE SERIES IS VERY LONG AND ALSO CON- 0032 

C SIDERABLY LONGER THAN THE OTHER THE 7090 TIME 0033 

C APPROACHES 2»NLAGS»L MACHINE CYCLES , WHERE 0034 

C NLAGS » DESIRED NO. OF OUTPUT CORRELATIONS AND 0035 

C L * LENGTH OF SHORTER SERIES. 0036 

C CASE 2. WHEN CROSS-CORRELATING TWO LONG, EQUAL-LENGTH 0037 

C SERIES FOR LAGS OF -MXLAG TO +MXLAG THE 7090 0038 

C TIME APPROACHES 2»MXLAG*(2»L-MXLAG) MACHINE CYCLES 0039 

C WHERE L IS THE COMMON LENGTH. AUTOCORRELATIONS TAKE 0040 

C HALF AS LONG. 0041 

C AUTHOR - R.A. WIGGINS JUNE, 1963 0042 

C 0043 

C USAGE 0044 

C 0045 

C TRANSFER VECTOR CONTAINS ROUTINES - FASCRl ,FAS£P1» IXCARG,L IMITS, 0046 

C PROCOR, REVERS,SETKS,STZ 0047 

C AND FORTRAN SYSTEM ROUTINES - NONE 0048 

C 0049 

C FORTRAN USAGE 0050 

C CALL QXCORKLXX, XX, LYY,YY, MXACC, ILAG, NLAGS, CQRRtlAD, 0051 

C 1 L SPACE, SPACE, IANS) 0052 

C 0053 

C INPUTS 0054 

C 0055 

C LXX =LX IS THE LENGTH OF X(I). 0056 

C MUST BE GRTHN* 1 0057 

C 0058 

C XXII) 1=1,..., LXX CONTAINS THE MLI VECTOR X(I). 0059 

C 0060 

C LYY -LY IS THE LENGTH OF Y(I). 0061 

C MUST BE GRTHN= 1 0062 

C 0063 

C YY(I) I=1,...,LYY CONTAINS THE MLI VECTOR Y(I). 0064 

C 0065 

C MXACC DEFINES THE ACCURACY OF THE VECTORS XX(I) AND YYU). 0066 

C ALL VALUES OF XX(I) AND YYU) MUST LIE BETWEEN -MXACC 0067 

C AND +MCACC INCLUSIVELY. 0068 

C MUST BE GRTHN«1, LSTHN- 1000 0069 

C 0070 

C ILAG IS THE INITIAL LAG AT WHICH THE CORRELATION IS BEGUN. 0071 

C 0072 

C NLAGS IS THE NUMBER OF LAGS FOR WHICH THE CORRELATION IS FOUND. 0073 
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MUST BE GRTHN* 



I AO 



LSPACE 



SPACE(I) 



OUTPUTS 



CORR(I) 



IANS 



=0 

NOT* 



IMPLIES CORRELATION REPLACES OUTPUT VECTOR. 
IMPLIES CORRELATION IS ADDED TO THE OUTPUT VECTOR. 



IS THE LENGTH OF TEMPORARY COMPUTATION SPACE AVAILABLE TO 
QXC0R1. 

MUST BE GRTHN* MIN(LXX,LYY) ♦ 1 ♦ 10*(MXACC+1) 

1=1,. ...LSPACE IS TEMPORARY COMPUTATION SPACE NEEDED 
BY QXC0R1. 



I*1,...,NLAGS CONTAINS THE CROSSCORRELATION 

C(J) J*ILAG,...,ILAG*NLAGS-1 AS DEFINED IN THE 
ABSTRACT. 



»0 
= 1 
*2 
=3 
=4 
=5 



NORMALLY 

IF ILLEGAL LXX (LSTHN* 0) 
IF ILLEGAL LYY ( LSTHN- 0) 
IF ILLEGAL MXACC (LSTHN*0, GRTHN 1000) 
IF ILLEGAL NLAGS ( LSTHN 38 0) 
IF ILLEGAL LSPACE (SEE ABOVE) 
*24 IF ILLEGAL VALUE OF XX OR YY FOUND BY PROCOR 

(ABS(XXU)) GRTHN MXACC). 
*33 IF OVERFLOW OCCURS - SEE PROCOR WRITEUP. 



EXAMPLES 



1. INPUTS - 



OUTPUTS - 

INPUTS 
OUTPUTS 



LXX » 2 
LYY = 3 
NLAGS=5 
I LAG » 0 
IANS = 0 



XX(l...2) = 
YY(1...3) * 
C0RR(1...5) 

MXACC * 100 
CQRRU...5) 



MLI 1,2 
ML I 5,4,3 
* MLI 1,1,1,1,1 
IAD = 0 LSPACE 
MLI 13,10,0,0,0 



1050 



SAME AS EXAMPLE 1. EXCEPT ILAG « -4 IAD 
IANS * 0 C0RRU...5) = MLI 1,1,4,11,14 



PROGRAM FOLLOWS BELOW 

DIMENSION CM(2),C0RR(2),SPACE(2) 
COMMON CM 

BRING IN SOME OF THE ARGUMENTS 



CALL SETKS (LXX,LX, 
CALL IXCARG (XX, IX) 
CALL IXCARG ( YY, IY ) 

CHECK ERROR CONDITIONS 



LYY,LY, ILAG, ILG, NLAGS, LZ) 



CALL LIMITS (1,IAN, LX, 1,32561, LY, 1,32561, MXACC, 1 , 1000, 
1 LZ, 1,32 561, LSPACE, 1+XMINOF ( LX, LY )+10*( MXACC* 1 ) ,32561 ) 
IF ( IAN) 5,5,900 
5 CONTINUE 

C 

C CLEAR THE OUTPUT AREA IF IAD=0 
C 

IF (IAD) 20,10,20 
10 CALL STZ (LZ,CORR) 
20 CONTINUE 



C CHOP OFF UNUSED PORTIONS FROM LEFT OF 
C 



XX AND YY. 





KMAX=ILG+LZ-1 








IF ( ILG ) 30,60,50 






30 


CONTINUE 

IF (KMAX) 40,60,60 






40 


CALL SETKS (LY+KMAX,LY, 
IF (LY) 900,900,60 


IY-KMAX,IY, 


I LG-KMAX , ILG, 0,KMAX) 


50 


CALL SETKS (LX-ILG,LX, 
IF (LX) 900,900,60 
SET UP PARAMETERS 


IX+ILG,IX, 0 


,ILG, LZ-l.KMAX) 



0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
uiuo 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
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60 


CONTINUE 




0149 




LXMLY=LX-LY 




0150 


C 


SET SWITCHES WHICH DEPEND ON LX-LY 




0151 




IF (LXMLY) 230,220,220 




0152 


220 


CALL SETKS (LY,LYT, IY,IYI, IX,IXI) 




0153 




GO TO 240 




0154 


230 


CALL SETKS (LX,LYT, IX,IYI, IY,IXI, -KMAX, ILG, -ILG 


,KMAX) 


0155 




CALL REVERS (LZ,CORR) 




0156 


C 


SET ARGUMENTS WHICH DEPEND ON ILG,LZ 




0157 


240 


CALL SETKS (-1,IF3, -1,IF2, XMAXOF ( ILG,-LYT+1 ) , NF12 


, 0,NF13) 


0158 




IF (LXMLY) 320,310,320 




0159 


310 


NF13*XMIN0F(LYT-1,KMAX) 




0160 




GO TO 390 




0161 


320 


IF (KMAX) 390, 390,330 




0162 


330 


NF23=XM INOF ( XA8SF ( LXMLY )-l , KMAX-1 ) 




0163 




KMAX1*KMAX-NF23-1 




0164 




IF (NF23) 350,350,340 




0165 


340 


IF 2=1 




0166 




IF (KMAX1) 390,350,350 




0167 


350 


IF3=1 




0168 




NF33=XMIN0F(LYT-1,KMAX1) 




0169 


390 


CONTINUE 




0170 




CALL PROCOR (CM( IYI ) ,LYT,MXACC, SPACE (L SPACE) , SPACE , 


ERR) 


0171 




IF (ERR) 910,500,910 




0172 


500 


CONTINUE 




0173 




IZ«-ILG+1 




0174 




CALL FASCR1 (CMC IX I ) ,NF12,NF13,C0RR( IZ) ,ERR) 




0175 




IF (ERR) 920,510,920 




0176 


510 


IF UF2) 530,530,520 




0177 


520 


CONTINUE 




0178 




IZ=IZ+1 




0179 




CALL FASEPl (CM( IXI+1) » 0,NF23-1 »CORR( IZ) ,ERR) 




0180 




IF (ERR) 920,530,920 




0181 


530 


IF (IF3) 550,550,540 




0182 


540 


IXI-IXI+NF23+1 




0183 




IZ=-ILG+NF23+2 




0184 




CALL FASCR1 (CM ( IX I ) »0»NF33,CORR( IZ ) , ERR ) 




0185 




IF (ERR) 920,550,920 




0186 


550 


CONTINUE 




0187 




IF (LXMLY) 600,610,610 




0188 


600 


CALL REVERS (LZ.CORR) 




0189 


610 


CONTINUE 




0190 


900 


IANS^IAN 




0191 




RETURN 




0192 


910 


IANS=ERR+20« 




0193 




GO TO 550 




0194 


920 


IANS=ERR+30. 




0195 




GO TO 550 




0196 




END 




0197 
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* ROATA » 



RDATA { SUBROUTINE ) 
LABEL 



3/15/65 LAST CARD IN DECK IS NO. 



CRDATA 



SUBROUTINE RDATA ( I TAPE t ITPCPY, I ANSt SPACE) 



ABSTRACT 

TITLE - RDATA 

READ DATA IN GENERALIZED FORMAT 

SUBROUTINE RDATA PROVIDES A SIMPLIFIED TECHNIQUE FOR 
INPUT ING SMALL AMOUNTS OF DATA. RDATA COMPARES A 
HOLLERITH NAME FOUND ON THE DATA CARD WITH NAMES IN ITS 
CALLING SEQUENCE. WHEN IT FINDS MATCHING NAMES IT THEN 
INTERPRETS THE DATA THAT FOLLOWS AS FIXED, FLOATING, OR 
OCTAL NUMBERS OR AS HOLLERITH INFORMATION AND STORES IN 
LOCATIONS CORRESPONDING TO THE HOLLERITH ARGUMENT. 
THE POSITION OF STORAGE IN VECTORS IS CONTROLLED BY 
GIVING INDEX VALUES ON THE CARD. IF NONE IS GIVEN, RDATA 
PUTS THE FIRST VALUE IN THE FIRST LOCATION OF THE VECTOR. 
RDATA SCANS CARDS (80 COLUMNS PER CARO) UNTIL IT 
ENCOUNTERS THE WORD 'RETURN' , THEN IT RETURNS CONTROL 
TO THE MAIN PROGRAM. IF RDATA ENCOUNTERS UNI NTERPRET ABLE 
INFORMATION ON THE CARDS, AN ERROR FLAG IS SET. 

IF THE USER DESIRES, RDATA WILL COPY, VERBATIM, EACH 
CARD THAT IT INTERPRETS ON OUTPUT TAPE 2 . 

RDATA REQUIRES A SPECIAL UOH) ROUTINE THAT CAN INTERPRET 
INPUT 'G' FORMATS. SUCH A ROUTINE IS DISTRIBUTED BY 
SHARE AS 19 SI GIOH NUMBER 1402. 



LANGUAGE 

EQUIPMENT 

STORAGE 

SPEED 

AUTHOR 



- FORTRAN II SUBROUTINE 

- 709 OR 7090 (MAIN FRAME AND TAPE UNIT) 

- 645 REGISTERS 



R. A. WIGGINS 



4/64 



USAGE 

TRANSFER VECTOR CONTAINS ROUTINES - ARG,CMPRA,HVTOI V, INTHOL, IVTOHV, 

I XCARG, RETURN, SETUP, STORE 
AND FORTRAN SYSTEM ROUTINES - (FID ,(RTN), (STH) , (TSH) 



FORTRAN USAGE 

CALL RDATA ( IT APE, ITPCPY, IANS, SPACE, X1NAME,X1, 



INPUTS 



XNNAME , XN) 



I TAPE 



ITPCPY 



LOGICAL INPUT TAPE NUMBER. 
IS NOT CHECKED FOR VALIDITY. 

LOGICAL TAPE NUMBER THAT ROATA WILL COPY EACH DATA CARD 
ONTO AND ON WHICH IT WILL INDICATE CARD COLUMNS 
IN WHICH ERRORS OCCUR. 
» 0 INDICATES NOTHING WILL BE PRINTED. 

SPACE(I) 1=1. ..110 IS TEMPORARY STORAGE SPACE NEEDED BY RDATA. 



X1NAME 



XNNAME 



LEFT ADJUSTED HOLLERITH WORD GIVING THE NAME OF A 
VARIABLE, OR VECTOR, THAT DATA MAY BE STORED IN. 



N-TH HOLLERITH NAME. 



DATA CARDS ON TAPE ITAPE. RDATA SEARCHES FOR A NAME THAT 
CORRESPONDS TO X1NAME. . .XNNAME, THEN IT STORES SUBSEQUENT 
INFORMATION UNTIL IT FINDS ANOTHER NAME. THE INFORMATION MAY 
BE OF THE FOLLOWING TYPES (EACH FIELD MUST BE SEPARATED BY AT 
LEAST ONE SPACE, COMMA, OR EQUALS SIGN). 

INDEX OF VECTOR - INDICATED BY PLACING PARENTHESES AROUND A 



0395 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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C FIXED POINT NUMBER • MULTIPLE PERIOOS INSIDE THE 0075 

C PARENTHESES (SEPARATED FROM THE INDEX BY AT LEAST ONE 0076 

C SPACE > AND SUCCEEDING EQUALS SIGNS ARE IGNORED. 0077 

C 0078 

C FIXED POINT NUMBERS - INDICATEO BY THE ABSENCE OF A DECIMAL 0079 

C POINT IN THE NUMBER. 0080 

C 0081 

C FLOATING POINT NUMBERS - INDICATED BY THE PRESENCE OF A 0082 

C DECIMAL POINT, OR BY E FORMAT. 0083 

C 0084 

C OCTAL NUMBERS - INDICATED BY A FINAL 'O* (OH) FOLLOWING 0085 

C 12 OCTAL DIGITS. 0086 

C 0087 

C HOLLERITH CHARACTERS - INDICATED BY «NH« WHERE N IS THE 0088 

C COUNT OF THE NUMBER OF CHARACTERS FOLLOWING «H» TO BE 0089 

C INTERPRETED. IF THIS FIELD EXTENDS BEYOND THE END OF 0090 

C THE CARD, IT IS TRUNCATED TO THE END. 0091 

C 0092 

C • RETURN* - CAUSES RDATA TO RETURN CONTROL TO THE CALLING 0093 

C PROGRAM. 0094 

C 0095 

C 0096 

C OUTPUTS 0097 

C 0098 

C XI.. XN HAVE OATA STORED IN THEM ACCORDING TO DATA CARDS 0099 

C 0100 

C IANS * 0 IF ALL OK 0101 

C * -1 IF THE NUMBER OF ARGUMENTS IS LSTHN 6 OR ODD 0102 

C » A POSITIVE COUNT OF THE NUMBER OF FIELDS THAT RDATA 0103 

C FOUND UNINTERPRETABLE, IF THESE OCCUR. 0104 

C 0105 

C 0106 

C EXAMPLES (DATA INDICATES A CARD ON TAPE ITAPE) 0107 

C 0108 

C 1. INPUTS - ITAPE * 2 ITPCPY 0 0109 

C USAGE - CALL RDATA{ I TAPE , I TPCPY , I ANS, SPACE, 1HX, X , 1H J, J ) 0110 

C DATA - X 1 1. 0000100000000 6HABCDEF J 5 RETURN 0111 

C OUTPUTS - IANS * 0 XU...4) * 1 , 1 . , 8, 6HABCDEF J*5 0112 

C 0113 

C 2. INPUTS - SAME AS EXAMPLE 1. 0114 

C USAGE - SAME AS EXAMPLE 1. 0115 

C DATA - X 0 0 0 0 0 0 (2) 2 (4 ...)* 4 (6) * 6H***»*» RETURN 0116 

C OUTPUTS - IANS * 0 XU...6J » 0,2,0,4, 0,6H**»»»» 0117 

C 0118 

C 3. INPUTS - SAME AS EXAMPLE 1. 0119 

C USAGE - SAME AS EXAMPLE 1. 0120 

C DATA - K=13 J=6 RETURN 0121 

C OUTPUTS - IANS = 1 J 35 6 0122 

C 0123 

C 0124 

C PROGRAM FOLLOWS BELOW 0125 

C 0126 

DIMENSION CM(2),ICM(2) 0127 

COMMON CM,ICM 0128 

EQUIVALENCE (CM, ICM) , !NUM,XNUM) 0129 

C 0130 

C SETUP LOCATE TO HANDLE VARIABLE ARGUMENT COUNT 0131 

C 0132 

CALL SETUP (L0CALL,NARGS,XR1,XR2) 0133 

C 0134 

C CHECK IF ARGUMENT COUNT IS LEGAL 0135 

C 0136 

IF ( NARGS-4) 20,20,10 0137 

10 CONTINUE 0138 

IF ( XMODF (NARGS,2) ) 40,40,20 0139 

20 CONTINUE 0140 

IANS=-1 0141 

30 CONTINUE 0142 

CALL RETURN (L0CALL,XR1,XR2 ) 0143 

40 CONTINUE 0144 

C 0145 

C SET UP THE INDICES W.R.T. COMMON OF VARIOUS VECTORS. 0146 

C 0147 

CALL IXCARG (SPACE, IHOL) 0148 

IH0LE=IH0L«-13 0149 
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IV1B*IH0LE+1 




0150 




IV1E*IV1B*5 




0151 




IV2B*IV1E*3 




0152 




IV2E=IV2B*80 




0153 




IANS-0 




0154 


c 






0155 


C GET NEXT CARD 




0156 


C 






0157 


100 


CONTINUE 




0158 




READ INPUT TAPE I TAPE, 110, (CM{ I ) , I=IHOL, IHOLE) 


0159 


110 


FORMAT (14A6) 




0160 




ICARD=ICARD+1 




0161 




HLN«0. 




0162 




IV=IV2B-1 




0163 


C 






0164 


C COPY CARD VERBATIM IF ITPCPY EXCEEDS ZERO 




0165 


C 






0166 




IF (ITPCPY) 130,130,120 




0167 


120 


CONTINUE 




0168 




WRITE OUTPUT TAPE ITPCPY, 125, ICARD, (CM( I ) , 


I-IHOL, IHOLE) 


0169 


125 


FORMAT (3X6HCARD (15, 7H ) » • 13A6, A2, 1H» ) 




0170 


130 


CONTINUE 




0171 


C 






0172 


C SCAN CARD. FIRST, SPREAD HOLLERITH - ONE LETTER 


PER WORD 


0173 


C 






0174 




CALL HVTOIV ( CM ( IHOL ) , 14, CM ( I V2B ) ) 




0175 


C 






0176 


C INITIALIZE SWITCHES - SCAN TO FIRST CHARACTER 




0177 


C 






0178 


135 


CONTINUE 




0179 




ASSIGN 550 TO KINDEX 




0180 


136 


CONTINUE 




0181 




ten ■* r\ r\ rn i/mmh 




m n? 




ASSIGN 160 TO KBLK 




0183 




ASSIGN 500 TO KNUM 




0184 




ASSIGN 400 TO KALPH 




0185 




ASSIGN 300 TO KPER 




0186 




ASSIGN 480 TO KLPRN 




0187 




ASSIGN 220 TO KE 




0188 




ASSIGN 220 TO KH 




0189 




ASSIGN 220 TO KO 




0190 




ASSIGN 135 TO KSTO 




0191 




ASSIGN 136 TO KALP1 




0192 


C 






0193 


C RESET COPY REGION TO BLKS 




0194 


C 






0195 


140 


CONTINUE 




0196 




IIV1=IV1B-1 




0197 




DO 150 I=IV1B,IV 




0198 


150 


ICM( I) =48 




0199 


C 






0200 


C GET NEXT CHARACTER, CHECK IF CARD IS COMPLETED 




0201 


C 






0202 


160 


CONTINUE 




0203 




IV=IV+1 




0204 




IF (IV-IV2E) 180,180,100 




0205 


180 


CONTINUE 




0206 




IVT=ICH(I V) 




0207 




ICMt IV)^48 




0208 




GO TO KNND ,(190,570) 




0209 


C 






0210 


C BRANCH ON CHARACTER TYPE 




0211 


C 






0212 


190 


CONTINUE 




0213 




IVI=IVT+1 




0214 


C 


0 01234567 




0215 




GO TO (210,210,210,210,210,210,210,210, 




0216 


C 


1 8 9 ILL ILL ILL ILL 




0217 




1 210,210,800,200,210,800,800,800, 




0218 


C 


2 +ABCDEFG 




0219 




2 210,220,220,220,220,250,220,220, 




0220 


C 


3 H I ILL . ) ILL ILL ILL 




0221 




3 260, 220, 800, 230, 200, 800, 800, 800, 




0222 


C 


4 -JKLMNOP 




0223 




4 210,220,220,220,220,220,270,220, 




0224 
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C 5 Q R ILL $ * ILL ILL ILL 0225 

5 220, 220, 800, 220, 220, 800, 800, 800 , 0226 
C6 BLK/STUVWX 0227 

6 200,220,220,220,220,220,220,22 0, 0228 
C 7 Y Z ILL , ( ILL ILL ILL 0229 

7 220,220,800,200,240,800,800,800), IVI 0230 
C BLANK CHARACTER • , )*• 0231 

200 GO TO KBLK, (160,320,420,520) 0232 

C NUMERICAL CHARACTER • *-0123456789« 0233 

210 GO TO KNUM, (500,220,510) 0234 

C GENERAL ALPHABETIC • A8CDFGIJKLMNPQRSTUVWXYZS*/ • 0235 

220 GO TO KALPH, (400,410, 800) 0236 

C PERIOD ••• 0237 

230 GO TO KPER ,(300,160,200,210) 0238 

C LEFT PARENTHESIS •(• 0239 

240 GO TO KLPRN, 1480,800) 0240 

C EEE »E« 0241 

250 GO TO KE ,(220,210) 0242 

C AITCH «H« 0243 

260 GO TO KH ,(220,750) 0244 

C OH «0* 0245 

270 GO TO KO ,(220,700) 0246 

C 0247 

C SPECIAL ENTRY TO SKIP MULTIPLE PERIODS 0248 

C 0249 

300 CONTINUE 0250 

IF ( ICMUV+D-27) 210,310,210 0251 

310 CONTINUE 0252 

ASSIGN 320 TO KBLK 0253 

ASSIGN 160 TO KPER 0254 

GO TO 160 0255 

320 CONTINUE 0256 

ASSIGN 160 TO KBLK 0257 

ASSIGN 300 TO KPER 0258 

GO TO 160 0259 

C 0260 

C FIRST CHARACTER IS ALPHABETIC, SCAN TO END 0261 

C 0262 

400 CONTINUE 0263 

ASSIGN 420 TO KBLK 0264 

ASSIGN 410 TO KALPH 0265 

ASSIGN 220 TO KNUM 0266 

ASSIGN 200 TO KPER 0267 

ASSIGN 420 TO KALP1 0268 

410 CONTINUE 0269 

IIV1=IIV1+1 0270 

ICM( IIVD^IVT 0271 

GO TO 160 0272 

C 0273 

C END FOUND, CONVERT FIRST SIX CHARACTERS TO HOLLERITH 0274 

C 0275 

420 CONTINUE 0276 

CALL IVTOHV (CM( IV1B) , 1,HLN) 0277 

C 0278 

C IF HLN * 6HRETURN, LEAVE 0279 

C 0280 

IF (CMPRAF( HLN, 6HRE TURN) ) 430, 30,430 0281 

C 0282 

C OTHERWISE, LOOK FOR HLN IN CALLING SEQUENCE 0283 

C 0284 

430 CONTINUE 0285 

DO 440 IARG=5,NARGS,2 0286 

IF (CMPRAF(HLN, ARGFtLOCALL, IARG, 1) ) ) 440,450,440 0287 

440 CONTINUE 0288 

C 0289 

C HLN CANNOT BE IDENTIFIED, GO TO ERROR PROCEDURE 0290 

C 0291 

HLN=0« 0292 

GO TO 800 0293 

C 0294 

C HLN IS NOW DEFINED BY IARG, GO SCAN FOR VALUES 0295 

C 0296 

450 CONTINUE 0297 

IARG'IARG+1 0298 

IX=0 0299 
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GO TO 136 


0300 


c 




0301 


C FIRST CHARACTER IS LEFT PAREN 


0302 


C 




0303 


480 


CONTINUE 


0304 




ASSIGN 540 TO KINDEX 


0305 




GO TO KALP1 , (136,420) 


0306 


C 




0307 


C FIRST CHARACTER IS NUMERICAL* SCAN ACROSS 


0308 


C 




0309 


500 


CONTINUE 


0310 




ASSIGN 520 TO KBLK 


0311 




ASSIGN 510 TO KNUM 


0312 




ASSIGN 800 TO KALPH 


0313 




ASSIGN 210 TO KPER 


0314 




ASSIGN 800 TO KLPRN 


0315 




ASSIGN 210 TO KE 


0316 




ASSIGN 750 TO KH 


0317 




ASSIGN 700 TO KO 


0318 


510 


CONTINUE 


0319 




IIV1=IIV1+1 


0320 




ICM{ IIV1)=IVT 


0321 




GO TO 160 


0322 


C 




0323 


C END OF NUMBER FOUND, CONVERT IT 


0324 


C 




0325 


520 


CONTINUE 


0326 




r u t * o u i f \ 


0327 


530 


CUNT INUE 


0328 




NHOL=i I IV 1- IV18+6 ) /6 


0329 




CALL IVTuHV ( I CM ( I V1B) ,NHOL , CMC I HOD I 


0330 




/"■Ait r itTuni # fti i if) i Mil t n^i t riiT i « r\i tu ftn m % 

CALL INTHOL (NHOL,CM( IHOL I , FMT, 1, IOUM,NUM) 


0331 




UU IU MINUCAf » 3tUf3JUt3QUi 




C 




0333 


C IF 


Tut c tc am t nmcv neccT ?v 
IHlb lb AIM lNUCA, RcScT IX 


0334 


C 




0335 


540 


CUN 1 INUc 


0336 




IX=NUM-1 


0337 




GO TO 135 


0338 


C 




0339 


C IF 


THIS IS OCTAL, OR NUMBER, STORE IT 


0340 


C 




0341 


550 


CONTINUE 


0342 




IF (HLN) 555,556,555 


0343 


555 


CONTINUE 


0344 




IX*IX+1 


0345 




CALL STORE (NUM,LOCALL, IARG, IX) 


0346 


556 


CONTINUE 


0347 




GO TO KSTO, ( 135,140) 


0348 


C 




0349 


C IF 


THIS IS HOLLERITH, STORE NEXT NUM CHARACTERS 


0350 


C 




0351 


560 


CONTINUE 


0352 




NUMH-NUM 


0353 




NUM1=XMIN0F(NUM,IV2E-IV-1) 


0354 




FMT=4H( A6 ) 


0355 




IV2ET=IV+NUM1 


0356 




ASSIGN 570 TO KNND 


0357 




ASSIGN 550 TO KINDEX 


0358 




ASSIGN 140 TO KSTO 


0359 




GO TO 140 


0360 


570 


CONTINUE 


0361 




IIV1=IIV1+1 


0362 




ICM( IIV1MIVT 


0363 




IF (IV-IV2ET) 580,590,590 


0364 


580 


IF (IIV1-IV1E) 160,530,530 


0365 


590 


CONTINUE 


0366 




IF (IIV1-IV1B) 135,600,600 


0367 


600 


CONTINUE 


0368 




ASSIGN 135 TO KSTO 


0369 




GO TO 530 


0370 


C 




0371 


C THIS IS AN OCTAL NUMBER 


0372 


C 




0373 


700 


CONTINUE 


0374 
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FMT=5H(012) 0375 

GO TO 530 0376 

C 0377 

C THIS IS HOLLERITH 0378 

C 0379 

750 CONTINUE 0380 

ASSIGN 560 TO KINOEX 0381 

GO TO 520 0382 

C 0383 

C ERROR FOUND, SCREAM, BUMP IANS, AND CONTINUE 0384 

C 0385 

800 CONTINUE 0386 

IANS=I ANS+1 0387 

IF (ITPCPY) 830,830,810 0388 

810 CONTINUE 0389 

INDEX=IV-IV2B+1 0390 

WRITE OUTPUT TAPE ITPCPY, 820, INDEX 0391 

820 FORMAT ( 42H ILLEGAL CARD FORMAT BEGINNING IN COLUMN 14) 0392 

830 CONTINUE 0393 

GO TO 135 0394 

END 0395 



*•*»«••***#***»*»«»*•»•« PROGRAM LISTINGS 

» REFIT « 

»•••*••*»#»****»***»•*«* 

REFER TO 
SPLIT 



**•#**•***•*••«*»******* 

4 REFIT * 
#*•**••**•*•••*»***•*»»* 

REFER TO 
SPLIT 



•»«»•»»••*••**••**•**«»* PROGRAM LISTINGS ^*t*##*#*»»#*»«»»**»««#* 

* REFLEC • * REFLEC • 

»••#•••••••«•*••••**•*•* 4#* *#****»*•*#* 



* REFLEC C SUBROUTINE ) 9/29/64 LAST CAftD IN DECK IS NO. 0107 
» FAP 0001 
•REFLEC 0002 

COUNT 100 0003 

LBL REFLEC 0004 

ENTRY REFLEC C X, LX, XMIROR, X IMAGE) 0005 

ENTRY XRFLEC I IX, LIX , IXMIRR, IX IMGE ) 0006 

* 0007 
« ABSTRACT 0008 

* 0009 

* TITLE - REFLEC WITH SECONDARY ENTRY XRFLEC 0010 

* REFLECT A FIXEO OR FLOATING VECTOR THROUGH A CONSTANT 0011 

* 0012 
» REFLEC SETS A FLOATING VECTOR EQUAL TO A CONSTANT MINUS 0013 

* A GIVEN FLOATING VECTOR, OUTPUT CAN REPLACE INHUTi 0014 

* 0015 
» XRFLEC OOES THE SAME THING FOR FIXED VECTORS. 0016 
« 0017 

* LANGUAGE - FAP SUBROUTINES (FORTRAN^II COMPATIBLE) 0018 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0019 

* STORAGE - 28 REGISTERS 0020 

* SPEED - REFLEC 34 ♦ 12.4*L MACHINES CYCLESt 0021 

* XRFLEC 36 + 8.0*L L= VECTOR LENGTH 0022 
» AUTHOR - S.M. SIMPSON, SEPTEMBER 1963 0023 
» 0024 

* USAGE — — 0025 

* 0026 

* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0027 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0028 

* 0029 

* FORTRAN USAGE 0030 

* CALL REFLEC ( X, LX, XMIROR, X IMAGE) 0031 

* CALL XRFLECIIX,LIX, I XMI RR, IX IMGE ) 0032 

* 0033 

* INPUTS 0034 

* 0035 

* XII) 1=1. ..LX IS A FLOATING VECTOR 0036 

* LX SHOULD EXCEED 0 0037 

* XMIROR IS A FLOATING CONSTANT 0038 

* 0039 

* IXCI) 1=1. ..LIX IS A FIXED VECTOR 0040 

* LIX SHOULD EXCEED 0 0041 
» IXMIRR IS A FIXED CONSTANT 0042 

* 0043 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUTS IF LX OR LIX LSTHN 1 0044 

* 0045 
» XIMAGEU) 1 = 1. ..LX IS XIMAGECI) = XM - XU) 0046 

* WHERE XM * INPUT VALUE OF XMIROR (XMIftOR WILL BE 0047 
« AN OUTPUT IF BOTH PERMISSIBLE EQUIVALENCES BELOW ARE 0048 

* USED) 0049 
« 0050 

* IXIMGEII) 1 = 1.. .LIX IS IXIMGEU) = IXM - IX(I) 0051 
» WHERE IXM = INPUT VALUE OF IXMIRR 0052 

* 0053 
« EQUIVALENCE (XMI ROR, SOME X i I ) ) , I X IMAGE, X ) ARE 0054 

* PERMITTED. SIMILARLY FOR THE FIXED POINT QUANTITIES. 0055 

* 0056 
» EXAMPLES 0057 

* 0058 

* 1. INPUTS - XII. ..4) » 1., 2., 3., 4. IX(1.U4) * 1,2,3,4 0059 
» XR2 = -999. 0060 

* USAGE - CALL REFLEC ( X, 4, 5., XR1) 0061 
» CALL XRFLECt IX, 4, 0, IXR1) 0062 
» CALL REFLEC ( X, 4, 5., X) 0063 

* CALL XRFLEC( IX, 4, IX(3),IX) 0064 

* CALL REFLEC ( X, 0, 5., XR2) 0065 

* OUTPUTS - XRIU.4.4) = 4., 3., 2., I. IXRH1...4) = -l,-2*-3»-4 0066 

* X(l.i.4) = 4., 3., 2., 1. IXU...4) = 2, 1* 0,-1 0067 
» XR2 = -999. (NO OUTPUT CASE) 0068 

* 0069 
» PROGRAM FOLLOWS BELOW 0070 

* 0071 

* 0072 
» NO TRANSFER VECTOR 0073 

HTR 0 XR4 0074 
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BCI 


It REFLEC 




0075 


* PRINCIPAL 


ENTRY. REFLEC 


(X,LX,XMIROR,XIMAGE) 


0076 


REFLEC 


CLA 


FSB 




0077 


SETUP 


STO 


SUBTR 




0078 




SXD 


REFLEC-2,4 




0079 


Kl 


CLA 


1,4 




0080 




ADD 


Kl 


A(X)+1 


0081 




STA 


SUBTR 




0082 




CLA 


4,4 




0083 




ADD 


Kl 


A(XIMAGE)+1 


0084 




STA 


STORE 




0085 




CLA* 


3,4 


XMIROR 


0086 




STO 


MI ROR 




0087 




CLA* 


2,4 


LX 


0088 




TMI 


LEAVE 




0089 




PDX 


0,4 




0090 




TXL 


LEAVE, 4,0 




0091 


» REFLECTING 


LOOP 




0092 


GET 


CLA 


M I ROR 




0093 


SUBTR 


NOP 




FSB **,4 OR SUB **,4 **=ACX>+1 


0094 


STORE 


STO 


**,4 


**=A(XIMACE)+1 


0095 




TIX 


GET, 4, I 




0096 


» EXIT 








0097 


LEAVE 


LXD 


REFLEC-2,4 




0098 




TRA 


5,4 




0099 


* SECOND ENTRY. XRFLECUX, 


LIX, IXMIRR, IXIMGE) 


0100 


XRFLEC 


CLA 


SUB 




0101 




TRA 


SETUP 




0102 


* CONSTANTS, 


TEMPORARIES 




0103 


FSB 


FSB 


** ,4 




0104 


SUB 


SU8 


**,4 




0105 


Ml ROR 


P7F 


*»«»«,** 


=XMIROR 


0106 




END 






0107 
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* RE I M * 



REFER TO 
AMPHZ 



* RE I M * 
*♦##**«■****#**#♦##»♦###« 

REFER TO 
AMPHZ 
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» REMAV * 
**«*••••***«•******•***« 



PROGRAM LISTINGS 



***#*»*••*•***•*«»«•**»» 
* REMAV » 
« ****•*••••*•*•**•*»»«** 



•REMAV 



REMAV 
FAP 

COUNT 

LBL 

ENTRY 



{ SUBROUTINE ) 



100 
REMAV 

REMAV (X* LXfXAVGt XNULD) 



9/29/64 



LAST CARD IN DECK IS NO. 



• — — ABSTRACT 

* 

» TITLE - REMAV 

• REMOVE THE MEAN FROM A FLOATING VECTOR 
* 

• REMAV COMPUTES THE AVERAGE VALUE OF A FLOATING VECTOR* 
» THEN SETS AN OUTPUT VECTOR WITH ELEMENTS EQUAL TO TWOSE 

• OF THE INPUT VECTOR MINUS THE AVERAGE. THE OUTPUT 

• VECTOR MAY REPLACE THE INPUT VECTOR. THE AVERAGE IS 

• ALSO AN OUTPUT QUANTITY. 
» 

• LANGUAGE - FAP SUBROUTINE ( FORTRAN—I I COMPATIBLE) 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 

• STORAGE - 36 REGISTERS 

« SPEED - 67.4 ♦ 20.8«L MACHINE CYCLES ON 7090. L * VECTOR LENGTH 

• 7?. 4 ♦ 20.8*L MACHINE CYCLES ON 709 

• AUTHOR - S.M. SIMPSON, SEPTEMBER 1963 
* 

• USAGE >- 

• 

» TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 

• AND FORTRAN SYSTEM ROUTINES - (NONE) 
• 

• FORTRAN USAGE 

» CALL REMAV (X.LX, XAVG, XNULD ) 

• 

» INPUTS 
» 

• X(I) 

• LX 

• OUTPUTS 
» XAVG 
» XNULD(I) 

• EXAMPLES 
• 

• 1. INPUTS - 

• USAGE 



1*1. ..LX IS A FLOATING VECTOR. 
SHOULD EXCEED ZERO. 

STRAIGHT RETURN WITH NO OUTPUT IF LX LSTHN 1. 
IS (l/LX) * (SUM (FROM 1=1 TO LX) OF XU)I. 
I=1.*.LX IS XNULD(I) = X(I) - XAVG. 
E QUI VALENCE ( XfXNULD) IS PERMITTED. 



OUTPUTS 



X(1.*.S) * 1., 2., 3., 4., 5. XAVG4 
CALL REMAV( X, 5, XAVGlt XNULD) 
CALL REMAV( X, 2, XAVG2, X) 
CALL REMAV( X, I, XAVG3, Y) 
CALL REMAV( X, 0, XAVG4, Z) 

XAVG1 * 3. XNULDU...5) * -2., -1., Oi 

XAVG2 * 1.5 XU...2) * -.5, .5 

XAVG3 * -.5 Y » 0. 

XAVG4 » Z * -999, (NO OUTPUT CASE) 



Z = -999. 



1., 



» PROGRAM FOLLOWS BELOW 



* NO TRANSFER VECTOR 



0105 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 





HTR 


0 




XR4 


0063 




BCI 


It REMAV 




0064 


ONLY 


ENTRY. 


REMAV 


tX,LX 


tXAVGtXNULD) 


0065 


REMAV 


SXD 


REMAV- 


-2,4 




0066 


Kl 


CLA 


It* 






0067 




ADD 


Kl 




A(X)+1 


0068 




STA 


ADD1 






0069 




STA 


GET 






0070 




CLA 


4,4 






0071 




ADD 


Kl 




A(XNULD>+1 


0072 




STA 


STORE 






0073 




CLA 


3,4 




A(XAVG) 


0074 
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STA 


FSB 




0075 


► CHEC 


K LS ANO 


FLOAT IT. 




0076 




CLA» 


2,4 


LX 


0077 




TMI 


LEAVE 




0078 




POX 


0,4 




0079 




TXL 


LEAVE, 4,0 




0080 




LRS 


18 




0081 




ORA 


OCTK 




0082 




FAD 


OCTK 


FLOATED LX 


0083 




STO 


FLX 




0084 


► SUM 


XU...LX) 


1, DIVIDE, 


STORE. 


0085 




PXD 


0,0 




0086 


AOD1 


FAD 


«*,4 


**=A(xm 


0087 




TIX 


ADD1,4,1 




0088 




FDP 


FLX 




0089 




LXD 


REMAV-2,4 




0090 




STQ* 


3,4 


XAVG 


0091 


* MEAN 


REMOVAL 


LOOP 




0092 




CLA* 


2,4 


LX 


0093 




POX 


0,4 




0094 


GET 


CLA 


**,4 


**=A(X)+1 


0095 


FSB 


FSB 


»* 


*«~A(XAVG> 


0096 


STORE 


STO 


»*t4 


**=A(XNULDm 


0097 




TIX 


GET, 4,1 




0098 


EXIT 








0099 


LEAVE 


LXD 


REMAV-2,4 




0100 




TRA 


5,4 




0101 


CONSTANTS, VARIABLES 




0102 


OCTK 


OCT 


233000000000 


0103 


FLX 


PZE 


*# 


= LX FLOATED 


0104 




END 






0105 



• ••«•••»»•«**•*•*****»** PROGRAM LISTINGS 

* REREAD * ¥ REREAD * 
•****»•*•*•**••*•»*««»•• ***#**»•*#•*••*«**•*••»* 

• REREAD (SUBROUTINE) 9/9/64 LAST CARD IN DECK IS NO. 0282 

• FAP 0001 
•REREAD 0002 

COUNT 150 0003 

LBL REREAD 0004 

ENTRY REREAD 0005 

ENTRY EOFSET ( ZIFTRN, EOF, ITAPE > 0006 

ENTRY ENDFIL (ITAPE) 0007 

ENTRY (TSH) (TAPE TO STORAGE HOLLERITH) 0008 

ENTRY (TSHM) (TAPE TO STORAGE HOLLERITH-MONITOR) 0009 

• 0010 
» 0011 
» ——ABSTRACT 0012 

• 0013 

• TITLE - REREAD, WITH SECONDARY ENTRIES EOFSET, ENDFIL, (1TSHI, (TSHM) 0014 

• REREAD DATA RECORD AND END FILE MONITOR 0015 

• 0016 

• REREAD IS A MODIFICATION OF THE FORTRAN— I I BCD TAPE 0017 
» READING ROUTINE (TSH) THAT ALLOWS THE USER GREATER 0018 
» FLEXIBILITY IN RE I NTERPRET AT ION OF CARDS AND IN THE 0019 
» SELECTION OF PROGRAMMED REACTION TO READING END— OF-F ILE 0020 

• MARKS, 0021 

• 0022 
» THE REREAD ENTRY ALLOWS THE RE I NTERPRET AT ION OF A CARD 0023 

• AS MANY TIMES AS THE USER DESIRES WITHOUT ACTUALLY 0024 
» REREADING THE INPUT TAPE. 0025 

• 0026 

• THE EOFSET ENTRY ALLOWS THE SELECTION OF A REACTION TO 0027 

• THE ENCOUNTER OF AN END— OF-F ILE ON THE TAPE. THE OPTIONS 0028 

• AVAILABLE ARE 1) EXIT TO MONITOR CONTROL, 2) TRANSFER TO 0029 

• A SPECIFIED POSITION IN THE MAIN PROGRAM, OR 3> SETTING 0030 
» OF A FLAG WHICH THE USER MAY CHECK IF HE WISHES. 0031 
» 0032 

• IF NEITHER OF THE SPECIAL OPTIONS ARE USED! THE PROGRAM 0033 

• SIMPLY DUPLICATES THE FUNCTIONS OF (TSH) AND (TSHM). 0034 

• 0035 
» LANGUAGE - FAP SUBROUTINES AND FUNCTION (FORTRAN II COMPATIBLE) 0036 

• EQUIPMENT - 709 OR 7090 (MAIN FRAME AND TAPE UNIT) 0037 

• STORAGE - 114 REGISTERS 0038 

• SPEED - 0039 
» AUTHOR - R.A. WIGGINS 4/64 0040 

• 0041 

• USAGE 0042 

• 0043 

• TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0044 

• AND FORTRAN SYSTEM ROUTINES - ( IOH) , ( RDS ) , ( RDC ) , ( RCH) TCO) , 0045 

• ( TEF ) , EX IT, ( RER ) 0046 
» 0047 
•XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY REREAD 0048 

• 0049 

• FORTRAN USAGE OF REREAD 0050 
» CALL REREAD 0051 
« 0052 

• CAUSES THE NEXT 'READ INPUT TAPE* STATEMENT TO RE INTER- 0053 

• PRET THE LAST CARO READ. WHEN USED, THESE READING STATE- 0054 

• MENTS SHOULD READ ONLY ONE CARD. REREAD MAY BE CALLED 0055 

• AS MANY TIMES AS DESIRED FOR VARIED INTERPRETATIONS OF 0056 
» THE CARD. 0057 

• 0058 
•XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ENTRY EOFSET 0059 

• 0060 
» FORTRAN USAGE OF EOFSET 0061 
» CALL EOFSET(ZIFTRN, EOF, ITAPE) 0062 

• 0063 

• EOFSET INITIALIZES THE (TSH) SUBPROGRAM TO ESTABLISH THE 0064 
« MODE OF REACTION TO AN END OF FILE ENCOUNTER. MAY BE 0065 
» RESET AS OFTEN AS DESIRED. 0066 
» 0067 

• INPUTS TO EOFSET 0068 

• 0069 

• ZIFTRN LSTHN 0 CAUSES (TSH) TO EXIT ON END-OF— F ILE (STANDARD 0070 

• OPERATING MODE IF EOFSET IS NEVER CALLED). 0071 

• * 0 CAUSES (TSH) TO TRANSFER TO THE FIRST STATEMENT 0072 
» FOLLOWING THIS 'CALL EOFSET* STATEMENT WITH AN ERROR 0073 

• FLAG (E0F=1.) WHEN AN END— OF— F ILE IS ENCOUNTERED. 0074 
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GRTHN 0 CAUSES (TSH) TO INTERPRET THE END-OF-F1LE AS A 
BLANK RECORD AND SETS AN END-OF-FILE FLAG WHICH USER 
MAY CHECK AT WILL (USING ENDFIL). 



* OUTPUTS FROM EOFSET 
• 

» EOF =0. AFTER EOFSET IS CALLED. 

» =1. IF ZIFTRN=0. IN THE LAST CALL OF EOFSET AND IF AN 

* END-0F~FILE IS ENCOUNTERED WHILE READING. 
• 

» I TAPE IS THE LOGICAL TAPE NUMBER THAT THE ENC-OF-FILE WAS 

* FOUND ON. CIS OUTPUTED ONLY WHEN EOF*L)W 
* 

♦XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX EWTRY ENDFIL 
• 

* FORTRAN USAGE OF ENDFIL FUNCTION 

* E0F1 * ENDFIL( ITAPE) 
* 

* ENDFIL IS USED TO CHECK IF AN END— OF— F ILE MAS 8NC0UNTERED 

* WHILE IN THE ZIFTRN GRTHN 0. MODE (SEE EOFSETI. 
* 

* OUTPUTS FROM ENDFIL 



E0F1 



ITAPE 



=0. IF NO END— OF-FILE WAS ENCOUNTEREDt OR IF EOFSET IS 
NOT IN THE Z IFTRN=1. MODE. 

»1. IF AN END-OF— F ILE WAS ENCOUNTEREDt AND IF 80FSET IS 
IN THE ZIFTRN^l. MODE, AND IF THIS IS THE FIRST CALL OF 
ENDFIL AFTER THE END— OF-F ILE WAS ENCOUNTERED* 



IS THE LAST LOGICAL TAPE NUMBER READ. 

•XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX COMPUTATIONAL EXAMPLES 
* 

* i. INPUTS - ITPEX * 5 KXU.*.4) * 5,5,5,5 LXU.*.4) » 5^5*5,5 

MXU...4) » 5,5,5,5 



REWIND ITPEX 

WRITE OUTPUT TAPE ITPEX, 10 

FORMAT ( 8H 12 3 4) 

END FILE ITPEX 

END FILE ITPEX 

END FILE ITPEX 

REWIND ITPEX 



READ INPUT TAPE ITPEX, 20, UXm,I=*l,4) 
F0RMAT(4I2> 
RE INTERPRET IN 14 FORMAT 
CALL REREAD 

READ INPUT TAPE ITPEX, 30, ( JX< I ) » 1=1, 2) 
F0RMAT(2I4) 
RE INTERPRET IN F FORMAT 
CALL REREAD 

READ INPUT TAPE ITPEX, 40, <XU),I*U4> 
F0RMAT(4F2.0) 

SETUP EOFSET IN ZIFTRN=1. MODE AND ENCOUNTER END OF 
FILE 

CALL E0FSETU.,E0F1, ITAPE1) 
READ INPUT TAPE ITPEX, 20, <KX< I ) 1 1*1, 4) 
E0F2 = ENDFIL i ITAPE2) 
E0F3 = ENDFIL ( ITAPE3) 
SET UP EOFSET IN ZIFTRN « 0. MODE AND ENCOUNTER NEXT 
END OF FILE 
CALL E0FSET(0.,E0F4, ITAPE4) 
IF (E0F4) 50,50,60 

READ INPUT TAPE ITPEX, 20, (LX(I),I=1,4) 
PROGRAM NEVER REACHES HERE 
RCHK=1. 

PROGRAM COMES HERE AFTER END OF FILE 
CONTINUE 

SET UP EOFSET IN ZIFTRN = -1. MODE AND ENCOUNTER 
LAST END OF FILE. 
CALL EOFSET ( -I. , E0F5, ITAPE5) 
READ INPUT TAPE ITPEX, 20, CMX(I), 1*1,4) 



* 




RCHK 


• 






* 


USAGE 


- C SET 


* 






• 






* 




10 


* 






• 






» 






• 






» - 




C OPE 


• 




C 1. 


• 






• 




20 


• 




C 2. 


• 






• 






» 




30 


* 




C 3. 


• 






• 






* 




40 


• 




C 4. 


• 




C 


• 






• 






» 






• 






» 




C 5. 


• 




C 


• 






• 






• 




50 


» 




C 


* 






* 




C 


* 




60 


» 




C 6. 


• 




C 


» 






» 







0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
Olli 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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• 




C PROGRAM 


EXITS 




0150 


• 












0151 


» OUTPUTS - 


IXC1...4) 


s 


1,2,3,4 




0152 


* 




JXIU..2) 




102,304 




0153 


• 




X(l...*4) 




l.,2.,3.,4. 




0154 


• 




EOFl=0* 


ITAPE1=0 KX( 1...4)=-0, -0,-0,-0 E0F2*1* 


0155 


• 




EOF3*0. 


ITAPE3-5 ITAPE2=5 




0156 


• 




E0F4*lW 


ITAPE4-5 LX( U..4)=5,5*5,5 RCHK » 


0. 


0157 


• 




£OF5=0. 


ITAPE5*0 MX( I.. .41=5, 5, 5, 5 




0158 


* 












0159 


• 












0160 


* PROGRAM FOLLOWS BELOW 








0161 


* 












0162 


XR4 


PZE 
BCI 


0 

It REREAD 








0163 
0164 


BUFSIZ 


EQU 


22 




BCD RECORD BUFFER SIZE 




0165 


* 












0166 


• READ 


INPUT TAPE ITAPE 


ENTRY IF NOT UNDER MONITOR CONTROL. 




0167 


* LOGICAL TAPE 


NUMBER IS 


IN 


THE ACCUMULATOR. 




0168 


• 












0169 


(TSH) 


STO 


ITAPE 




SAVE LOGICAL TAPE NUMBER. 




0170 




LDQ 


NOP 




PICKUP SWITCH SETTING, AND 




0171 




TRA* 


$( IOH) 




♦GO INITIALIZE ( IOH). 




0172 


NOP 


NOP 


TSH 




INPUT / TAPE TO STORAGE HOLLERITH. 


0173 


• 












0174 


• READ 


INPUT TAPE ITAPE 


ENTRY IF UNDER MONITOR CONTROL. 




0175 


• 












0176 


(TSHM) 


STO 


ITAPE 




SAVE LOGICAL TAPE NUMBER* 




0177 




LDQ 


NOP 




PICKUP SWITCH SETTING, AND 




0178 




SLQ 


TSHSW 




SET MONITOR SWITCH, THEN 




0179 




TRA* 


$ ( I OH ) 




•GO INITIALIZE < IOH). 




0180 


• 












0181 




i I uni • 








uioi: 


• 












0183 


TSH 


SXA 


TSHX, 4 




SAVE RETURN INDEX 




0184 


SWI1 


NOP 


RERE1 




TRA RERE1 IF REREAD ENTRY 




0185 




XEC* 


$(RDS) 




SELECT CURRENT UNIT 




0186 




AXC 


TSHC-4 




INITIALIZE 




0187 




PXA 


»4 




FOR 




0188 




STA* 


$(RDC) 




READ CHECKING. 




0189 




XEC* 


$(RCH) 




READ ONE TAPE RECORD. 




0190 


TSHSW 


TRA 


RER 




♦EXIT TO CHECK READING, UNLESS 




0191 




LDQ* 


$(TCO) 




IN MONITOR MODE, THEN 




0192 




SLQ 


TCO 




GET TCO AND 




0193 




LDQ* 


$ ( TEF ) 




TEF INSTRUCTIONS 




0194 




SLQ 


TEF 




FROM (IOS). 




0195 


TCO 


TCOA 


• 




WAIT TO COMPLETE READING. 




0196 


TEF 


TEFA 


$EXIT 




♦EXIT (TO EXIT OR MAIN) IF END 


OF FILE* 


0197 


RER 


TSX 


$(RER),4 




♦GO CHECK READING ERROR. 




0198 




AXT 


BUFSIZ^4 




SAVE 




0199 




CLA 


-1*4 




INPUT 




0200 




STO 


REC1 + U4 




BUFFER 




0201 




TIX 


♦-2,4,1 




IN REC1. 




0202 


TSHX 


AXT 


• ♦♦4 




RESET IR4, ANO 




0203 


TRA 


TRA 


It* 




♦REENTER < IOH). 




0204 


• 












0205 


• THAT 


IS ALL I 


OF THE READING OPERATION. 




0206 


* REREAD ENTRY. 








0207 


« 












0208 


REREAD 


SXD 


XR4,4 




SAVE IR4. 




0209 




CLA 


TRA 




SET SWITCH 




0210 




STD 


SWI1 




SWU, AND 




0211 




TRA 


1*4 




♦RETURN TO MAIN. 




0212 


* 












0213 


• REENTRY FROM 


SWI1 








0214 


• 












0215 


RERE1 


AXT 


BUFSIZ,'4 




RESTORE 




0216 




CLA 


RECl+l#4 




(IOH) 




0217 




STO 


-1,4 




BUFFER. 




0218 




TIX 


♦-2,4,1 








0219 




CLA 


NOP 




RESET SWITCH 




0220 




STD 


SWI1 




SWU, AND 




0221 




TRA 


TSHX 




♦RETURN TO (IOH). 




0222 


* 












0223 



• ••»•»•*»•••*****<•»•*•*« 

• REREAD * 

• »*»•••»**•«*-»•»*••«•••* 

(PAGE 4) 



PROGRAM LISTINGS 



«•«#*••*»*•*•«*•*•«*•*•• 

* REREAD » 
«•«•»•*•«**••****•«»*»•* 

(PAGE 4) 



» ENTRY TO DEFINE NEEDED ACTION IN CASE OF END-OF-FILE. 



0224 
0225 



XR4E PZE 


0 


CONTAINS XR4 FOR RETURN ON EOF 


0226 


EOFSET SXD 


XR4E,4 


SAVE IR4. 


0227 


STZ» 


2,4 


SET EOF TO ZERO, AND 


0228 


CLA» 


lt4 


CHECK DESIRED ACTION ON EOF ENCOUNTER* 


0229 


TZE 


EOFZ 




0230 


TPL 


EOFP 




0231 


CLA 


EXAD 


EOF=-X - EXIT ON EOF* 


0232 


TRA 


STOE 




0233 


EOFZ CLA 


TRAD 


EOF=0* - RETURN TO XR4E POSITION IN MAIN 


0234 


TRA 


STOE 


ON EOF. 


0235 


EOFP CLA 


COAD 


EOF=+X - SET EOF FLAG* 


0236 


STOE STA 


TEF 




0237 


TRA 


4,4 


•RETURN TO MAIN* 


0238 


• 






0239 


» CONTROL COMES HERE ON 


END OF FILE IN NON-MONITOR MODES* 


0240 


• 






0241 


TRAN LXD 


XR4£*4 


PREPARE TO RETURN TO XR4E* 


0242 


CLA 


= 1. 


SET 


0243 


STO* 


2,4 


EOF FLAG. 


0244 


CLA 


ITAPE 


SET TAPE NUMBER 


0245 


STO» 


3,4 


THAT EOF WAS ENCOUNTERED ON. 


0246 


TRA 


4,4 


•RETURN TO XR4E. 


0247 


CONTI AXT 


BUFSIZ,4 


SET 


0248 


CLA 


=0606060606060 BUFFER 


0249 


STO 


RECl+1,4 


TO 


0250 


TIX 


•-2,4,1 


BLANKS. 


0251 


CLA 


«l. 


SET 


0252 


STO 


EOF 


EOF FLAG. 


0253 


TRA 


RERE1 


•RETURN TO i IOH) INDIRECTLY. 


0254 


• 






0255 


» END OF FILE 


FUNCTION ENTRY 


0256 


* 






0257 


ENDFIL CLA 


ITAPE 


GET 


0258 


STO» 


1,4 


TAPE NO. 


0259 


CLA 


EOF 




0260 


STO 


E0F1 




0261 


STZ 


EOF 




0262 


CLA 


E0F1 




0263 


TRA 


2,4 


•RETURN TO MAIN. 


0264 


• 






0265 


* CONSTANTS AND STORAGE 


NEEDED BY REREAD ET AL. 


0266 


* 






0267 


EXAD PZE 


$EXIT 




0268 


TRAD PZE 


TRAN 




0269 


COAD PZE 


CONTI 




0270 


E0F1 PZE 


0 




0271 


EOF PZE 


0 




0272 


ITAPE PZE 


0 




0273 


BES 


BUFSIZ-1 




0274 


RECl PZE 


0 




0275 


• 






0276 


• RECORD READING AND BUFFER DEFINITIONS 


0277 


» 






0278 


TSHC IORT 


RECBUFSIZ READ 1 20-WORD BCD RECORD* 


0279 


COMMON 


-206+BUFSIZ 


0280 


REC COMMON 


1 


INPUT BUFFER 


0281 


END 






0282 
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* REVER (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0097 



* 


FAP 






0001 


•REVER 






0002 




COUNT 


100 




0003 




LBL 


REVER 




0004 




ENTRY 


REVER iX,LX,XREVD) 




0005 










0006 






ABSTRACT — 




0007 


* 








0008 




TITLE - REVER 




0009 


* 


REVERSE A VECTOR ELSEWHERE OR IN PLACE 




0010 


# 








0011 






REVER REVERSES THE STORAGE ORDER OF 


A VECTOR. 


0012 


* 




OUTPUT MAY REPLACE INPUT, 




0013 


* 








0014 


* 


LANGUAGE 


FAP SUBROUTINE (FORTRAN-II COMPATIBLE) 


0015 


* 


EQUIPMENT - 


709 OR 7090 < MAIN FRAME ONLY) 




0016 


• 


STORAGE 


30 REGISTERS 




0017 


* 


SPEED 


41 + 6#L MACHINE CYCLES, IF L IS 


EVEN, L* VECTOR LENGTH 


0018 


* 




47 + 6*L MACHINE CYCLES, IF L IS 


ODD 


0019 


• 


AUTHOR 


S.M. SIMPSON, SEPT 1963 




0020 


• 








0021 


• 




USAGE 




0022 


• 








0023 


• 


TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 




0024 


* 


AND FORTRAN SYSTEM ROUTINES - CNGNE) 




0025 


• 








0026 


• 


FORTRAN USAGE 




0027 


• 


CALL REVER U,LX,XREVD) 




0028 


• 








0029 


* 


INPUTS 






0030 


» 








0031 


• 


XU) 


I=1.*.LX IS A VECTOR IN ANY MODE 




0032 


• 








0033 


• 


LX 


SHOULD EXCEED 0 




0034 


• 








0035 


# 


OUTPUTS 


STRAIGHT RETURN WITH NO OUTPUT IF 


LX LSTHN 1 


0036 


• 








0037 


• 


XREVDH) 


1 = 1. * .LX IS XREVDU) = XUX), XREVDI2)= XUX-lt, ETC 


0038 


• 








0039 


• 




EQUIVALENCE IXREVD,X) IS PERMITTED 




0040 










0041 


* 


EXAMPLES 






0042 










0043 


* 


1. INPUTS - 


IXU..^4) = 1,2,3,4 




0044 




USAGE 


CALL REVERl IX, 1, IXR1) 




0045 


* 




CALL REVER( IX, 2, IXR2) 




0046 


* 




CALL REVERI IX, 3, IXR3) 




0047 


* 




CALL REVERI IX, 4, IXR4) 




0048 


• 


OUTPUTS - 


IXR1 = 1 IXR2U...2)* 2,1 IXR3U...3) * 3,2,1 


0049 


• 




IXR4tl«..4) » 4,3,2,1 




0050 


• 








0051 


• 


2. INPUTS - 


XU...3) * 1.9 2., 3. Y= -999. 




0052 


• 


USAGE 


CALL REVERIX,0,Y) 




005 3 


• 




CALL REVER(X,3,X) 




0054 


• 


OUTPUTS - 


Y * -999. i NO OUTPUT CASE) XII.. 


.3) * 3.,2.iTlw 


0055 


* 








0056 


* 


PROGRAM FOLLOWS BELOW 




0057 


• 








0058 


» 








0059 


• 


NO TRANSFER VECTOR 




0060 




HTR 


0 XR1 




0061 




HTR 


0 XR4 




0062 




8CI 


1 , REVER 




0063 


» 


ONLY ENTRY, 


REVER (X,LX,XREVD) 




0064 


REVER SXD 


REVER-2,4 




0065 




SXD 


REVER-3,1 




0066 


Kl CLA 


1,4 A(X) 




0067 




STA 


GETXH 




0068 




ADD 


Kl A(X)+1 




0069 




STA 


GETXL 




0070 




CLA 


3,4 A(XREVD) 




0071 




STA 


STOXL 




0072 




ADD 


Kl A(XREVD)+1 




0073 




STA 


STOXH 




0074 
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CLA* 


2,4 


LX 


0075 




TMI 


LEAVE 




0076 




ARS 


I 


LX/2 


0077 




POX 


0,1 


TRUNCATED. 


0078 




ADD 


KDHAF 


(LX+D/2 


0079 




PDX 


0,4 


TRUNCATED 


0080 




TXL 


LEAVE, 4,0 




0081 


EXCHANGE 


LOOP 




0082 




XR1 


STARTS AT LX/2 


TRUNCATED, MOVES UP. 


0083 




XR4 


STARTS AT (LX+D/2 TRUNCATED, MOVES DOWN* 


0084 


GETXH 


CLA 




*»=A(X) 


0085 


GETXL 


LDQ 


**,4 


*»=A(X)+1 


0086 


STOXH 


STO 


»*,4 


**=A(XREVD)+1 


0087 


STOXL 


STQ 


»*, 1 


*»=A(XREVD) 


0088 




TXI 


•♦1,1,1 




0089 




TIX 


GETXH, 4,1 




0090 


EXIT 








0091 


LEAVE 


LXD 


REVER-2,4 




0092 




LXD 


REVER-3,1 




0093 




TRA 


4,4 




0094 


CONSTANTS 






0095 


KOHAF 


OCT 
END 


000000400000 




0096 
0097 
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» REVERS (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0076 



» FAP 






uuui 


♦REVERS 






Anno 
KJKJVJz. 


COUNT 


60 




0003 


L8L 


REVERS 




UUU*t 


ENTRY 


REVERS (LX,X) 






* * 






0006 


• 


—ABSTRACT 




0007 


»- 






0008 


* TITLE - REVERS 




0009 


* FAST 


REVERSE STORAGE ORDER OF A VECTOR 




UU X u 


* 






0011 


» LANGUAGE F AP ^ SUBROUTINE (FORTRAN II COMPATIBLE! 


0012 


• EQUIPMENT - 709 OR T090 (MAIN FRAME ONLY 3 




001 3 


» STORAGE 


- 29 REGISTERS 




0014 


» SPEED 


- ABOUT 6*LX ♦ 32 MACHINE CYCLES 


ON THE 7090 


0015 


• 


WHERE LX IS THE LENGTH OF THE VECTOR. 


0016 


» AUTHOR - R.A. WIGGINS, 19/8/62 




0017 


• 






0018 


• 


— * — USAGE 




0019 


• 






0020 


» TRANSFER VECTOR CONTAINS ROUTINES - NONE 




0021 


» AND FORTRAN SYSTEM ROUTINES ~ NONE 




0022 


* 






0023 


* FORTRAN USAGE 




0024 


* CALL REVERSE LXt X) 




0025 


* 






0026 


* INPUTS 






0027 








0028 


* x ( I ) 


1=1 ... LX IS A VECTOR OF NUMBERS 


(ANY MODE) 


0029 


* 






0030 


» LX 


IS FORTRAN II INTEGER 




0031 


41 


MUST BE GRTHN=l 




0032 








0033 


* OUTPUTS 






0034 








0035 


» X ( I ) 


1*1. LX SAME AS ABOVE ONLY REVERSED 


0036 


• 






0037 


» EXAMPLES 






0038 


* 






0039 


♦ 1. INPUTS 


- X(l.*.4)=l»2,3,4 LX*4 




0040 


* OUTPUTS 


- X(i...4)=4,3,2,l 




0041 


• 






0042 


» 2. INPUTS 


- X(l...5)=l.,2.,3.,4.,5. LX = 5 




0043 


* OUTPUTS 


- X(i...5)=5.,4.,3.,2.,i. 




0044 


* 






0045 


» 3. INPUTS 


- X=l LX=1 




0046 


* OUTPUTS 


- X=l 




0047 


• 






0048 


PZE 






0049 


BCI 


1 t REVERS 




0050 


REVERS SXD 


»~2,4 




0051 


SXA 


ADR, I 




0052 


CLA 


2,4 




0053 


ADD 


= 1B35 




0054 


STA 


X 




0055 


STA 


X+t 




0056 


STA 


X+2 




0057 


STA 


X+3 




0058 


CLA* 


1,4 




0059 


PDX 


t4 




0060 


ARS 


1 




0061 


PDX 


,1 




0062 


SUB 


= 1B17 




0063 


TMI 


ADR-1 




0064 


STD 


*+l 




0065 


TIX 


*+l,4,«* 




0066 


X CLA 


»*, 1 




0067 


LDQ 


**,4 




0068 


STO 


*»,4 




0069 


STQ 


*»#1 




0070 


TXI 


♦♦1,4,1 




0071 


TIX 


X,l,l 




0072 


LXD 


REVERS-2,4 




0073 


ADR AXT 


♦ ♦,1 




0074 
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TRA 3,4 

END 



0075 
0076 
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» RLSPR (SUBROUTINE) 10/5/64 LAST CARD IN DECK IS NO. 0120 

» LABEL 0001 

CRLSPR 0002 
SUBROUTINE RLSPR I LL , AA, RR, ALP ) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - RLSPR 0007 

C REALIZABLE LEAST SQUARE PREOICTOR BY RECURSION, 1-DIMSENSI0N 0008 

C 0009 

C RLSPR INCREASES THE LENGTH OF A REALIZABLE, LEAST SQUARE 0010 

C PREDICTION ERROR OPERATOR Ai K» L ) BY ONE, THAT IS, GIVEN 0011 

C THE VECTOR AC K, L ) (K REFERS TO THE K-TH ELEMENT IN A 0012 

C VECTOR OF L+l ELEMENTS) THAT SATISFIES THE EQUATIONS 0013 

C 0014 

C ACL,L)*R(0) + ... + AC1,L)*R(L-1) * ACO,L)*R(L> * 0 0015 

C 0016 

C A(L,L)«R(1) + ... ♦ ACl,L3*R(L-2) + AC 0#L)*R(L-13* 0 001? 

C . 0018 

C . 0019 

C . 0020 

C A€L»L)*R(L-1) ♦ ... ♦ AC1»L)*R(0) ♦ AC0*L)*R(1) * 0 0021 

C 0022 

C WHERE A10,L) IS CONSTRAINED TO BE 1, THEN RLSPR INCREASES 0023 

C THE LENGTH OF A! K,L ) SO THAT IT SATISFIES THE EQUATIONS 0024 

C 0025 

C ACL+1,L+1)*R(0)+... + AC1,L+1)*R(L) + AC 0#L+1I*R(L*1 1=0 0026 

C ETC. 0027 

C 0028 

C IF R I K ) REPRESENTS THE AUTOCORRELATION OF A TIMf SERIES 0029 

C X(T) 0030 

C 0031 

C R(K) * EXPECTED VALUE ( X( T+K ) «XC T ) ) 0032 

C 0033 

C THEN THE SET OF EQUATIONS ABOVE ARE THE NORMAL EQUATIONS 0034 

C FOR THE PREDICTION ERROR OPERATOR 0035 

C 0036 

C ACL,L)*X(T-L) 4-...+ All,L)*X<T-l)+AIO,L)*Xm* EPSfT, L! 0037 

C 0038 

C WHERE EPSCT,L) IS THE ERROR SERIES. 0039 

C AS A MATTER OF TERMINOLOGY, WE DEFINE 0040 

C 0041 

C ACL,L)»R(1) ♦ AU,L)*RCL)+A(0,L)*RCL + 1)* ALPCL+1,L* 0042 

C A(l,L)»R(-L)+...+ AC i,L)*RC-l)+A( 0,L)«R(0) * ALP(0*LJ 0043 

C 0044 

C WHERE ALP(0,L) IS THE COVARIANCE OF EPSCT,LJ. THAf IS 0045 

C 0046 

C ALPC0,L) * EXPECTED VALUE < EPSC T,L )*EPSC T#L) ) . 0047 

C 0048 

C RLSPR RETURNS THE VALUE OF ALP(0,L+1>. 0049 

C 0050 

C LANGUAGE FORTRAN II SUBROUTINE 0051 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0052 

C STORAGE - 142 REGISTERS 0053 

C SPEED - ABOUT .000071*L ♦ .00040 SECONDS ON THE 7094 MOD 1 • 0054 

C AUTHOR - R*Aw WIGGINS 3/63 0055 

C 0056 

C USAGE — 005 7 

C 0058 

C TRANSFER VECTOR CONTAINS ROUTINES - FDOTR 0059 

C AND FORTRAN SYSTEM ROUTINES - NONE 0060 

C 0061 

C FORTRAN USAGE 0062 

C CALL RLSPR ( LL , AA, RR, ALP ) 0063 

C 0064 

C INPUTS 0065 

C 0066 

C LL IS THE LENGTH OF THE INPUT SERIES A. (EQUALS L*1J 0067 

C MUST 8f GRTHN-0 G068 

C 0069 

C AACI) 1*1, ...,LL CONTAINS THE OPERATOR AC0,L) THROUGH A(L,L). 0070 

C 0071 

C RRII) I=l,...,LL+l CONTAINS THE AUTOCORRELATION VECTOR RIO! 0072 

C THROUGH R(L+1). 0073 

C 0074 
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C ALP CONTAINS ALP(0,L) AS DEFINED IN THE ABSTRACT. 0075 

C 0076 

C OUTPUTS 0077 

C 0078 

C LL IS INCREASED ONE FROM THE INPUT VALUE. 0079 

C 0080 

C AAU) I*1,*..,LL (NEW LL) CONTAINS THE OPERATOR A(0,L+U 0081 

C THROUGH A(LU,LU> 0082 

C 0083 

C ALP CONTAINS ALP(0,LU>, 0084 

C 0085 

C EXAMPLES 0086 

C 0087 

C I. INPUTS - LL=*0 RRU...5) = 1. 25, . 5, 0. , 0. , 0. 0088 

C OUTPUTS - AAU) = 1. ALP=1.25 0089 

C 0090 

C 2. INPUTS - SAME AS EXAMPLE 1. 0091 

C USAGE - DO 10 1*1,5 0092 

C CALL RLSPR (LL,AA,RR,C) 0093 

C 10 CONTINUE 0094 
C OUTPUTS - AAU. ..5) = 1. ,-0 .4985, 0. 2463, -0. 1 173, 0.0469 ALP*1.0G07 0095 

C 0096 

C PROGRAM FOLLOWS BELOW 0097 

C 0098 

DIMENSION AAUO),RRUO) 0099 

L1=LL 0100 

L2=L1+1 0101 

IF(L1» 80,10,30 0102 

10 AA(l)=l. 0103 

ALP=RR(i) 0104 

GO TO 70 0105 

30 CALL FOOTR ( LI , AA , RR( 2 ) , ALPL ) 0106 

AAL=-ALKL/ A LI" 0107 

AA(L2)-0. 0108 

J=L2 0109 

LH=(L2+l)/2 0110 

35 DO 40 1=1, LH 0111 

AAT=AA ( J ) 0112 

AA ( J ) = AA< J ) + AAL« A A ( I ) 0113 

IF (J-I) 60,60,38 0114 

38 AAU )=AA(I)+AAL*AAT 0115 

40 J=J-1 0116 

60 ALP-ALP>AAL*ALPL 0117 

70 LL*L2 0118 

80 RETURN 0119 

END 0120 
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RLSPR2 (SUBROUTINE) 9/9/64 LAST CARO IN OfCK IS NO. 0280 

LABEL 0001 



CRLSPR2 0002 

SUBROUTINE RLSPR2 (NRA, NCAT, NCAN, AA,NRR, NCR, RR,C, IANS) 0003 

C 0004 

C — — ABSTRACT 0005 

C 0006 

C TITLE - RLSPR2 0007 

C REALIZABLE LEAST— SQUARE PREDICTOR BY RECURSION - 2 DIMENSIONS 0008 

C 0009 

C RLSPR2 INCREASES THE LENGTH OF ONE DIMENSION OF NRA 2- 0010 

C DIMENSIONAL LEAST SQUARE PREDICTION OPERATORS IY 0NE» 0011 

C WHERE NRA (NUMBER ROWS IN A) IS THE WIDTH OF THE OPERATOR 0012 

C IN THE OTHER DIMENSION. THAT IS, GIVEN THE PREDICTION 0013 

C OPERATORS A(I,J,K) I=1,...,NRA, J=0, It . • . ,NCAN# K=H.«.# 0014 

C NRA WHICH SOLVE THE EQUATIONS 0015 

C 0016 

C NRA NCAN 0017 

C SUM i SUM C AU,J,K)*RU-M, J+N-l) ) ) = 0 0018 

C 1=1 J=0 0019 

C 0020 

C FOR K - I,.*., NRA 0021 

C M = 1,...,NRA 0022 

C N = 1»..., NCAN 0023 

C 0024 

C WHERE ( 1. IF I=K 0025 

C A(I,0,K) = ( 0026 

C ( 0. IF I NOT = K 0027 

C 0028 

C THEN RLSPR2 INCREASES THE J/TH DIMENSION BY ONff SO THAT 0029 

C THE EQUATIONS ARE SATISFIED FOR J=0, 1, * * . , NCAN^NCAN*!. 0030 

C 0031 

C IF R<I t J) I=-NRA,... ,-1,0,1, ...NRA, J=0» 1, J..NGAN 0032 

C REPRESENTS ONE-HALF OF A TWO DIMENSIONAL AUTOCORRELATION 0033 

C 0034 

C R(K»L) * EXPECTED VALUE (X ( I+K, J+L)*X( I # J) ) 0035 

C 0036 

C THEN THE FIRST SET OF EQUATIONS ABOVE ARE THE NORMAL 0037 

C EQUATIONS FOR THE PREDICTION ERROR OPERATOR 0038 

C 0039 

C NRA NCAN 0040 

C SUM ( SUM ( A( I , J,K) »X( M— I ,N— J ) ) ) * EPS(M,tV,K) 0041 

C 1=1 J=0 0042 

C 0043 

C AS A SECONDARY OUTPUT, RLSPR2 RETURNS AN NRA X NRA MATRIX 0044 

C C(L,K) THAT IS DEFINED BY 0045 

C 0046 

C NRA NCAN 0047 

C C(L,K) = SUM ( SUM ( A(I*J r K)*R< I-L, J ) ) >. 0048 

C 1=1 J=0 0049 

C 0050 

C THE MATRIX CONTAINS THE COVARIANCE OF THE EXPECTED ERRORS 0051 

C SQUARED 0052 

C 0053 

C C(L,K) = EXPECTEO VALUE ( EPS! M, NH., K ) #*2 ) 0054 

C 0055 

C FOR L=i,...,NRA K=l,...,NRA. 0056 

C 0057 

C LANGUAGE - FORTRAN il SUBROUTINE 0058 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 005? 

C STORAGE - 700 REGISTERS 0060 

C SPEED - ABOUT .00010»M»N»»3 SECONDS ON THE 7094 MOD 1 0061 

C FOR N GRTHN 7 AND M GRTHN 25 . 0062 

C AUTHOR - R.A. WIGGINS MAY, 1963 GEOSCIENCE, INC. 0063 

C 0064 

C USAGE 0065 

C 0066 

C TRANSFER VECTOR CONTAINS ROUTINES - DOT J, DOTP» IXCARG»MATML3^M0VREV| 0067 

C SIMEQ,ST2 0068 

C AND FORTRAN SYSTEM ROUTINES - NONE 0069 

C 0070 

C FORTRAN USAGE 0071 

C CALL RLSPR2(NRA, NCAT, NCAN, AA.NRR, NCR, RR,C, IANS) 0072 

C 0073 
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C INPUTS 0074 
C 0075 

C NRA NUMBER ROWS OF A. 0076 

C MUST BE GRTHN=i 0077 

C 0078 

C NCAT NUMBER COLUMNS OF A TOTAL, UE. THIS IS THE UPPER LIMIT 0079 

C ON THE NUMBER OF COLUMNS OF A. 0080 

C MUST BE GRTHN=1 0081 

C 0082 

C NCAN NUMBER COLUMNS OF A NOW, I.E. THIS IS THE PRESENT LENGTH 0083 

C OF THE A PREDICTORS, 0084 

C MUST BE GRTHN=0, LSTHN=NCAT 0085 

C 0086 

C AA(L) L=l t • • • ,NRA*NCAT*NRA CONTAINS A(I,J*K> STORED AS FOLLOWS 0087 

C L=l.i.NRA CONTAINS I=I...NRA# J*0,K*1 0088 

C =NRA*1...2*NRA CONTAINS 1=1 • ••NRA * J*l »K*1 0089 

C • 0090 

C * K*l 0091 

C =(N€AN-l)»NRA+l...NCAN»NRA CONTAINS 1-1. . .JURA* J*NCAN 0092 

C =NCAT»NRA+1...NCAT*NRA*NRA CONTAINS I=1...NRA^J*0,K»2 0093 

C . 0094 

C . 0095 

C =NCAT+(NCAN~1)»NRA+1.*.NCAN*NRA 0096 

C CONTAINS 1 = 1.. JNRA,(J*NCAN#K*2 0097 

C ETC. 0098 

C 0099 

C NRR NUMBER ROWS OF R. 0100 

C MUST BE GRTHN= 1 AND ODD. 0101 

C 0102 

C NCR NUMBER COLUMNS OF R. 0103 

C MUST BE GRTHN=1 0104 

C 0105 

C NRR/2 K=0,... ,NCR-1 STORED CLOSELY SPACED* * ' 0107 

C 0108 

C C(I) 1=1 • . , 3*NRA*NRA+NRA IS COMPUTATION SPACE NEEDED BY 0109 

C RLSPR2. 0110 

C 0111 
C OUTPUTS 0112 
C 0113 

C NCAN IS INCREASED BY ONE 0114 

C 0115 

C AA(L) L=l » • . « »NRA»NCAT«NRA CONTAINS A(I,J*K), 1=1, • • • , NRA, 0116 

C J=0,...,NCAN-1, K=l,.i,,NRA STORED WITH 0117 

C CIMENSION (NRA, NCAT, NRA). 0118 

C 0119 

C C(I) I=i,...,NRA*NRA CONTAINS THE ERROR MATRIX DEFINED IN THE 0120 

C ABSTRACT STORED CLOSELY SPACED BY COLUMNS. 0121 

C 0122 

C IANS =0 IF NO TROUBLE 0123 

C =1 IF NCAN GRTHN=NCAT ON ENTRANCE 0124 

C =2 IF NCAN LSTHN 0 0125 

C =3 IF OVERFLOW OCCURS DURING INVERSION OF MATRIX C. 0126 

C =4 IF MATRIX C IS SINGULAR (THEORETICALLY IMPOSSIBLE!. 0127 

C 0128 
C 0129 
C EXAMPLES 0130 
C 0131 
C I. EXAMPLE OF A ONE-DIMENSIONAL AUTOCORRELATION 0132 

C INPUTS - NRA = 1 NCAT = 5 NCAN = 0 0133 
C NRR = 1 NCR = 2 RR(1...2) = 1.25, .50 0134 

C USAGE - DO 10 1=1, NCAT 0135 

C 10 CALL RLSPR2(NRA, NCAT, NCANtAA, NRR, NCR4RRte,IANSI 0136 

C OUTPUTS - IANS = 0 AAU...5) = 1.000,-0.499,0.246,-0. 117, C. 047 0137 
C C(i) = 1.001 0138 

C 0139 
C 2. EXAMPLE OF FIRST CALL OF RLSPR2 0140 

C INPUTS - NRA = 1 NCAT = 5 NCAN = 0 0141 
C NRR =3 NCR = 3 RR(1..,9) = 0.302 0.105 0.010 (STORED 0142 

C 1.340 0.621 0.202 BY 0143 

C 0*302 0.105 0.010 COLUMNS! 0144 

C USAGE - CALL RLSPR2( NRA, NCAT, NCAN, AA, NRR,NCR ,RR,C , 1 ANS) 0145 

C 0146 

C OUTPUTS - IANS = 0 AAU...45) = 1.000 0.000 0.000 0.000 0.000 0147 
C (EACH 3 ROW BY 0.000 0.000 0.000 0.000 0.000 0148 
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c 


5 COLUMN ARRAY 0.000 0.000 


0.000 


0.000 


0.000 


0149 


c 


IS STORED CLOSELY 








0150 


c 


SPACED BY COLUMNS. 0.000 0.000 


0.000 


0.000 


0.000 


0151 


c 


THE ARRAYS ARE 1.000 0.000 


0.000 


0.000 


0.000 


0152 


c 


ALSO CLOSELY 0.000 0.000 


0.000 


0.000 


0.000 


0153 


c 


SPACED.) 








0154 


c 


0.000 0.000 


0.000 


0.000 


0.000 


0155 


c 


0.000 0.000 


0.000 


0.000 


0.000 


0156 


c 


1.000 0.000 


0.000 


0.000 


0.000 


0157 


c 










0158 


c 


C(l.*.9) * 1.340 0.302 0.000 








0155 


c 


0.302 1.340 0.302 








0160 


c 


0.000 0.302 1.340 








0161 


c 










0162 


C 3, 


GENERAL EXAMPLE. 








0163 


c 


INPUTS - SAME AS EXAMPLE 2. 








0164 


c 


USAGE - SAME AS EXAMPLE 1. 








0165 


c 


OUTPUTS - IANS * 0 AAU...45) * 1.000 -0.507 


0.051 


0.079 


-0*046 


0166 


c 


0.000 0.032 


0.015 


-0.037 


0*019 


0167 


c 


0.000 -0.008 


-0.004 


0.011 


-0*006 


0168 


c 










0169 


c 


0.000 0.032 


0.015 


-0.037 


0*019 


0170 


c 


1.000 -0.515 


0.048 


0.090 


-0.052 


0171 


c 


0.000 0.032 


0*015 


-0.037 


0.019 


0172 


c 










0173 


c 


0.000 -0.008 


-0.004 


0.011 


-0*006 


0174 


c 


0.000 0.032 


0.015 


-0.037 


0.019 


0175 


c 


1.000 -0.507 


0.051 


0.079 


-0.046 


0176 


c 










0177 


c 


C(1...9> = 1.039 0.271 -0.002 








0178 


c 


0.271 1.037 0.271 








0179 


c 


-0*002 0.271 1.039 








0180 


c 










0181 


c 










0182 


C PROGRAM FOLLOWS BELOW 








0183 


C 










0184 




DIMENSION AA(2) ,RR( 2) ,C( 2) ,CM( 2) 








0185 




COMMON CM 








0186 




L=NRA 








0187 




M*NCAN 








0188 




MT^NCAT 








0189 




LL-L*L 








0190 




LLMT*LL*MT 








0191 




LMT«L*MT 








0192 




LM-L*M 








0193 




CALL IXCARG (C,IC1) 








0194 




IC2=IC1+LL 








0195 




IC3=IC2+XMAX0F(feL,L+L> 








0196 




IC4=IC3+LL 








0197 




CALL IXCARG ( AAg I A ) 








0198 




LH=(L+l)/2 








0199 




LHL S LH*L 








0200 




L1=L+1 








0201 




Ml*(NRR+U/2 








0202 




IAN=0 








0203 




IF (MT-M) 10,10,20 








0204 


10 


IAN=1 








0205 




GO TO 1000 








0206 


20 


CONTINUE 








0207 




IF ( M) 30,40,100 








0208 


30 


IAN=2 








0209 




GO TO 1000 








0210 


C SPECIAL CASE - M=0 








0211 


40 


CONTINUE 








0212 




CALL STZ ( LLMT , AA> 








0213 




CALL MOVREVlL,0^i.,LMT-»-i,AA,l) 








0214 




JCl^ICl 








0215 




JC2=IC1 








0216 




IR^Ml 








0217 




CALL STZ <Lt,C> 








0218 




00 60 11=1, L 








0219 




IF CIR) 70,70,50 








0220 


50 


CONTINUE 








0221 




LM0=L-IH-1 








0222 




CALL MOVREV (LM0,O,RR( IR) , LI ,CM ( JC 1 ) , 1 ) 








0223 
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CALL MOVREV ( LMO,0,RRf I R) , LI ,CM< JC2) , 1 ) 0224 

IR=I R-l 0225 

JCl-JCl+1 0226 

60 JC2=JC2+L 0227 

70 CONTINUE 0228 

GO TO 170 0229 

C GENERAL CASE 0230 

100 CONTINUE 0231 

C FIND ZETA MATRIX 0232 

JCl=IC3 0233 

DO 120 1 1 = 1 ,LLMT, LMT 0234 

DO 110 12=1, L 0235 

CALL OOTP (L,M,AAUl>,NRR f NCR,RR,Ml~I2,l,CM< JC1),-2J) 0236 

110 JC1=JC1+1 0237 

120 CONTINUE 0238 

C FIND K MATRIX 0239 

CALL MATML3 (L,t ,L,CMUC2> ,CM( IC3) , 0,CM{ IC4) »0> 0240 

1001 Z=l. 0241 

C FORM THE LENGTHENED PREDICTORS* 0242 

LMH=lLM+L+l>/2 0243 

KCl=IC2 0244 

KC2=IC2+L 0245 

IA1=1 0246 

IA2=LM+L 0247 

DO 160 1 3=1 » LMH 0248 

CALL MOVREV ( L , LMT , AAU Al ) , 1 , CM ( KC 1 ) , 1 ) 0249 

CALL MOVREV ( L , LMT , AA< I A2) , 1, CM( KC2 ) , 1 ) 0250 

JC1=KCI 0251 

JC2=KC2 0252 

KK1=IC4 0253 

DO 150 14=1, L 0254 

CALL DOTJ (L,1,CM<KK1), LMT, AA< I A2) ,CM< JC1),1,1> 0255 

CALL DOTJ (L,l,CM|KKl),LMT,AAf IA1),CM(JC2),1,1J 0<i!>6 

KK1=KK1+L 0257 

JC1=JC1+1 0258 

150 JC2=JC2+1 0259 

CALL MOVREV ( L , 1 ,CM< KC1 ) , LMT , AA ( I A 1 ) , 1 ) 0260 

CALL MOVREV ( L , 1 ,CM t KC2 ) ,LMT , AA < I A2 ) , 1 ) 0261 

IAl=IAl+l 0262 

160 IA2=IA2-1 0263 

C FORM NEW ALPHA MATRIX 0264 

CALL MATML3 ( L ,fc , L , CM ( IC3 ) , CMU C4 ) , 0, CM ( IC 1 ) , 1 ) 0265 

C FIND INVERSE OF ALPHA 0266 

170 CONTINUE 0267 

CALL MOVREV i LL 41 , CM ( IC 1 ) , 1 ,CMUC2 ) ,-1 ) 0268 

CALL STZ <LL,CM(IC3)) 0269 

CALL MOVREV (L,0,1., LI , CM ( IC3 ) , 1 ) 0270 

D= L • 0271 

CALL SIMEQ < L, L 4 L*CM ( IC2 ) ,CM ( IC3 ) , D, CM ( IC4 ) , ERR ) 0272 

IF (ERR) 190,190,180 0273 

180 IAN=ERR+2. 0274 

GO TO 1000 0275 

190 CONTINUE 0276 

NCAN=M+1 0277 

1000 IANS=IAN 0278 

RETURN 0279 

END 0280 
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» RLSSR ( SUBROUTINE ) 9/29/64 LAST CARD IN DECK IS NO* 0114 

• LABEL 0001 

CRLSSR 0002 
SUBROUTINE RLSSR ( LLt AA» RRtGG?FF* ALP ) 0003 

C 0004 

C -ABSTRACT 0005 

C 0006 

C 0007 

C TITLE - RLSSR 0008 

C REALIZABLE LEAST SQUARE SHAPER BY RECURSION 0009 

C 0010 

C RLSSR INCREASES THE LENGTH OF A REALIZABLE LEAST SQUARE 0011 

C SHAPER FILTER F<K,L> BY ONE* THAT IS t GIVEN THE VECTOR 0012 

C FCK*L) (K REFERS TO THE K-TH ELEMENT IN A VECTOR OF 0013 

C LENGTH L) THAT SATISFIES THE EQUATION 0014 

C 0015 

C F(L,L)*R(0) ♦ ... + FUfL)»R(L-l) » G(L-1> 0016 

C 0017 

C FCL,L)»R(-n ♦ ... + FU*L)*RU-2) * GtL-2f 0018 

C . 0019 

C . 0020 

C FtL,LJ*R(-L+l)+ ... + FC1.L)«RI0) * GdO) 0021 

C 0022 

C AND A< K*L) ANO ALP(0*L) AS GIVEN BY RLSPR 0023 

C THEN RLSSR INCREASES THE LENGTH OF Fl K?L ) SO THAT 0024 

C IT SATISFIES THE EQUATIONS 0025 

C 0026 

C F(L+lf L + 1)*R<0> + ... ♦ F(1,U1)*RIL1 = G ( L ) 0027 

C ETC* 0028 

C 0029 

C IF R(K) REPRESENTS THE AUTOCORRELATION OF A WAVELET XCT) 0030 

C 0031 

C RCK) * SUM (X<T+K)»Xm> 0032 

C 0033 

C AND GI K) REPRESENTS THE CROSSCORREL AT ION OF A DESIRED 0034 

C OUTPUT © ( T ) WITH THE WAVELET X(T) 0035 

C 0036 

C G ( K 3 a SUM <D<T)*X(T~IO) 0037 

C 0038 

C THEN THE FIRST SET OF EQUATIONS ABOVE ARE THE NORMAL 0039 

C EQUATIONS FOR A SHAPER FILTER 0040 

C 0041 

C OCT) - (FIL,L)«X(T-L) ♦ ... + FU,L)»XtT-l> * ZET( T*L) 0042 

C 0043 

C WHERE ZET (T» L) IS THE ERROR SERIES. 0044 

C 0045 

C LANGUAGE - FORTRAN II SUBROUTINE C046 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0047 

C STORAGE - 82 REGISTERS 0048 

C SPEED - ABOUT *000162*L ♦ .00011 SECONDS ON THE 7094 MOD 1 . 0049 

C AUTHOR - R. A." WI6GINS 3/63 0050 

C 0051 

C ——USAGE 0052 

C 0053 

C TRANSFER VECTOR CONTAINS ROUTINES - FDOTR 0054 

C ANO FORTRAN SYSTEM ROUTINES - NONE 0055 

C 0056 

C FORTRAN USAGE 0057 

C CALL RLSSR ILL t AA, RR, GG, FF, ALP ) 0058 

C 0059 

C INPUTS 0060 

C 0061 

C LL =L*1 THE OUTPUT LENGTH OF THE SERIES F. 0062 

C MUST BE GRTHN= 1 0063 

C 0064 

C AAU) I =1 1 . . . t LL CONTAINS THE PREDICTION ERROR OPERATOR A|0,L1 0065 

C THROUGH A ( Lf L ) . 0066 

C 0067 

C RR( I ) I=l*..*,LL CONTAINS THE AUTOCORRELATION VECTOR RlO) 0068 

C THROUGH R(L). 0069 

C 0070 

C GGU) I~lt...,LL CONTAINS THE CROSSCORREL AT ION VECTOR G<0) 0071 

C THROUGH G ( L ) . 0072 

C 0073 

C FFU) I^1,*..,LL-1 CONTAINS THE SHAPER FILTER F(l.L) THROUGH 0074 
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C F ( Lt L ) - 0075 

C 0076 

C ALP CONTAINS THE ERROR COVARIANCE ALP<0,L). 0077 

C 0078 

C OUTPUTS 0079 

C 0080 

C FFCI) 1=1, ...,LL CONTAINS THE NEW SHAPER FILTER FU,L*1) 0081 

C THROUGH F(L+l,L+l). 0082 

C 0083 

C EXAMPLES 0084 

C 0085 

C i. INPUTS - LL=0 RR(1...5)=1.25,.5,0.,0.,0. 0086 

C €G(1...5) = l.,0.,0.,0.,0. 0087 

C USAGE - CALL RLSPR < LL, AA, RR, ALP ) 0088 

C CALL RLSSR < LL, AA, RR , GG, FF, ALP ) 0089 

C OUTPUTS - LL=i AACi)=l. ALP=1.25 FFIl) = i8 0090 

C 0091 

C 2. INPUTS - SAME AS EXAMPLE 1. 0092 

C USAGE - DO 10 1=1,5 0093 

C CALL RLSPR (LL,AA, RR, ALP) 0094 

C CALL RLSSR < LL, AA,RR,GG,FF, ALP) 0095 

C 10 CONTINUE 0096 

C OUTPUTS - AA€1»««5) » 1.000, -0.498, 0.246, -0.117, 0.047 0097 

C FFU...5) * .999, -0.498, 0.246, -0.117, 0.047 0098 

C LL*5 ALP=1. 00073 0099 

C 0100 

C PROGRAM FOLLOWS BELGW 0101 

C 0102 

DIMENSION AA(10),RR(10),GG<10),FF(10) 0103 

L2=LL 0104 

L1*L2-1 0105 

CALL FDOTR ( LI , FF , RR( 2 ) , CI ) 0106 

i t-»uwii.t« vk / hit islvsi 

FF(L2)=0. 0108 

J=L2 0109 

DO 10 1=1, L2 0110 

FFU) = FF ( I )+ FL*AA( J ) 0111 

10 J=J-1 0112 

RETURN 0113 

END 0114 
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* RMSDAV * 

••••***•*•*•**••«***»*** 

REFER TO 

RMSDEV 



# RMSOAV * 
*»«#*•*•*•»•*«****««#*** 

REFER TO 

RMSDEV 



••••**•«»*••«*•****•»*•« PROGRAM LISTINGS 

* RMSDEV « # RMSDEV » 

»••«•»• •#*»***•***•* «*•••***•*••••**»*•«««•« 



« RMSDEV (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO. 0159 

» FAP 0001 

♦RMSDEV 0002 

COUNT 150 0003 

LBL RMSDEV 0004 

ENTRY RMSDEV ( X, LX , XBASE, RMSXMB ) 0005 

ENTRY RMSDAV ( X ,LX ,XAVG, RMSXMA) 0006 

* 0007 

* 0008 

* -* ABSTRACT 0009 

* 0010 
« TITLE - RMSDEV WITH SECONDARY ENTRY RMSDAV 0011 
» R.M.S. DEVIATION FROM GIVEN BASE OR FROM TRUE AVERAGE 0012 

* 0013 

* RMSDEV COMPUTES THE ROOT MEAN SQUARE VALUE OF THE 0014 

* DEVIATIONS, FROM A GIVEN BASE, OF THE ELEMENTS OF 0015 

* A VECTOR, 0016 

* 0017 

* RMSDAV COMPUTES THE AVERAGE OF A VECTOR AND THEN 0018 

* THE RMS VALUE OF THE DEVIATIONS OF ITS ELEMENTS 0019 

* AROUND THE AVERAGE* THE AVERAGE IS AN ADDITIONAL 0020 

* OUTPUT. 0021 

* 0022 

* LANGUAGE - FAP SUBROUTINES CFORTRAN-II COMPATIBLE) 0023 

* EQUIPMENT - 709,7090,7094 (MAIN FRAME ONLY) 0024 

* STORAGE - 50 REGISTERS 0025 
» SPEED - ON THE 7090 0026 

* RMSDEV TAKES ABOUT 70 + 33.8*L + K MACHINE CYCLES 0027 

* RMSDAV TAKES ABOUT 100 ♦ 43.2*L + K MACHINE CYCLES 0028 
» WHERE L = VECTOR LENGTH 0029 

* K * CYCLES FOR ONE SQUARE ROOT 0030 

* AUTHOR - S.M.SIMPSON, FEBRUARY 1964 0031 
» 0032 

* 0033 

* ■* USAGE 0034 

* 0035 

* TRANSFER VECTOR CONTAINS ROUTINES - < NOT ANY) 0036 

* AND FORTRAN SYSTEM ROUTINES - SQRT 0037 

* 0038 

* FORTRAN USAGE OF RMSDEV 0039 

* CALL RMSDEV(X,LX, XBASE, RMSXMB) 0040 

* 0041 

* INPUTS TO RMSDEV 0042 
» 0043 

* XU) I=1.*.LX IS A FLOATING POINT VECTOR 0044 

* 0045 

* LX SHOULD EXCEED ZERO 0046 

* 0047 

* XBASE IS A FLOATING POINT CONSTANT 0048 

* 0049 
» OUTPUTS FROM RMSDEV (STRAIGHT RETURN WITH NO OUTPUTS IF LX ESTHN 1) 0050 

* 0051 

* RMSXMB =SQUARE ROOT( ( SUM ( FROM I=l..LX)OF(X(I )— XBASE ) SQUARED1 /LX> 0052 
» 0053 
« 0054 
» FORTRAN USAGE OF RMSDAV 0055 

* CALL RMSDAV ( X, LX ,X AVG, RMSXMA ) 0056 

* 0057 

* INPUTS TO RMSDAV 0058 
» 0059 
» X(I) 1 = 1.. .LX IS A FLOATING POINT VECTOR 0060 

* 0061 
» LX SHOULD EXCEED ZERO 0062 
» 0063 
» OUTPUTS FROM RMSDAV (STRAIGHT RETURN WITH NO OUTPUTS IF LX MSTHN 1) 0064 

* 0065 

* XAVG * (1/LX)*(SUM(FR0M 1=1. .iLX) OF XU)) 0066 
» 0067 

* RMSXMA =SQUARE ROOTU SUM( FROM 1=1. .LX) OF(X{ I )—XAVG)SQUARE01/LX| 0068 
» 0069 
» 0070 

* EXAMPLES 0071 

* 0072 
» I. INPUTS - X(1...9) = 1. ,2. ,3. ,4. ,5. ,6. ,7. ,8. ,9. LX=9 0073 

* USAGES - CALL RMSDEV ( X , LX , 0. , RMS 1 ) 0074 
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LISTINGS #*##»*«#*#*******#»«##*• 
* RMSDEV * 
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* CALL RMSDEV(X,LX, 1., RMS2) 0075 
» CALL RMSDAV<X,LX,XAVG,RMS3J 0076 

* OUTPUTS - RMSl = (i/3)*SQUARE ROOT(285) » 5.62731 0077 
» RM52 = (l/3)*SQUARE R00TI204) = 4. 76095 0078 
» RMS3 = (1/3)*SQUARE ROOTC60) = 2.58199 0079 

* 0080 

* 0081 

* PROGRAM FOLLOWS BELOW 0082 

* 0083 

* TRANSFER VECTOR CONTAINS SQRT 0084 

* 0085 
HTR 0 XR4 0086 
BCI 1, RMSDEV 0087 

» 0088 

» PRINCIPAL ENTRY. RMSDEV ( X, LX, XBASE, RMSXMB I 0089 

* 0090 
RMSDEV STZ ZFDEV SET ENTRY INDICATOR 0091 

TRA SETUP 0092 

* 0093 
» SECONDARY ENTRY. RMSDAV ( X, LX, XAVG t RMSXMA ) 0094 

* 0095 
RMSOAV SXA ZFDEV ,4 SET ENTRY INDICATOR 0096 
» 0097 

* SAVE XR4, SET ADDRESSES 0098 
» 0099 

SETUP SXD RMSDEV-2,4 0100 

Kl CLA 1,4 A(X) 0101 

ADD Kl A(X)+1 0102 

STA GET 0103 

CLA 3,4 A( XBASE OR XAVG) 0104 

STA SUBTR 0105 

* 0106 

* CHECK OUT LX, SET IT IN XR4, FLCAT IT, CLEAR SUM, BRANCH ON ENTRY 0107 

* 0108 
CLA* 2,4 LX, 0109 
TMI LEAVE 0110 
PDX 0,4 TO XR4, 0111 
TXL LEAVE, 4,0 0112 
LRS 18 0113 
ORA OCTK 0114 
FAD OCTK 0115 
STO FLX AND FLOATED. 0116 
STZ SUM SUM CLEARED. 0117 
NZT ZFDEV 0118 
TRA GET ALL SET IF RMSDEV 0119 

* 0120 

* IF RMSDAV, COMPUTE AND STORE XAVG AND THEN RESTORE XR4 TO LX 0121 

* 0122 
PXO 0,0 0123 
FAD» GET 0124 
TIX *-l,4,l 0125 
FDP FLX 0126 
LXD RMSDEV-2,4 0127 
STQ* 3,4 STORE XAVG 0128 
CLA* 2,4 0129 
PDX 0,4 LX BACK TO XR4 0130 

* 0131 

* COMPUTE THE SUM OF SQUARE DEVIATIONS 0132 
» 0133 

GET CLA **»4 **=A(X)+1 0134 

SUBTR FSB *» **«A(XBASE) OR A(XAVG) 0135 

STO TEMP 0136 

XCA 0137 

FMP TEMP 0138 

FAD SUM 0139 

STO SUM 0140 

TIX GET, 4,1 0141 

* 0142 

* COMPUTE RMS VALUE, STORE IT, EXIT. 0143 

* 0144 
FDP FLX 0145 
XCA 0146 
TSX $SQRT,4 0147 
LXD RMSDEV— 2,4 0148 
STO* 4,4 0149 



• RMSOEV » 
*****«•*••»*«***•******• 

(PAGE 3) 



PROGRAM LISTINGS 
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* RMSDEV * 
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LEAVE TRA 5,4 0150 

» 0151 

* CONSTANTS, TEMPORARIES 0152 

« 0153 

OCTK OCT 233000000000 0154 

SUM PZE *»,#»,## SUM REGISTER 0155 

TEMP PZE **,#»,#* INDIVIDUAL DEVIATIONS 0156 

FIX PZE #*,»*,♦* LX FLOATING 0157 

ZFDEV PZE »* f 0,0 **=0 IF RMSDEV, NON-ZERO IF RMSDAV 0158 

END 0159 



*#*********«*•«»»**•*»«* 
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PROGRAM LISTINGS 



**»«»••«*••»•*****••*••» 

♦ RND ♦ 
*«•*•*+**«»*••*»••*•«•»* 



» RND (FUNCTION) 9/29/64 LAST CARD IN DECK IS NO, 0078 

* FAP 0001 
»RND 0002 

COUNT 60 0003 

LBL RND 0004 

ENTRY RND F(Y) 0005 

ENTRY RNDUP FCY) 0006 

ENTRY RNDDN F(Y) 0007 

» 0008 

* ABSTRACT 0009 

* 0010 

* TITLE - RND , WITH SECONDARY ENTRY POINTS RNDUP, RNDDN 0011 

* ROUNDS FLTG. PT. NO. UP, DOWN, OR TO NEAREST FLTG* PT. INTEGER 0012 

* 0013 

* RND ROUNDS A FLOATING POINT NUMBER TO THE NEAREST FLOATING 0014 

* POINT INTEGER. 0015 

* 0016 

* RNDUP ROUNDS A POSITIVE (NEGATIVE) FLOATING POINT NUMBER 0017 

* TO THE NEXT HIGHER ( LOWER ) FLOATING POINT INTEGER. 0018 

* 0019 

* RNDDN ROUNDS A POSITIVE (NEGATIVE) FLOATING POINT NUMBER 0020 

* TO THE NEXT LOWER (HIGHER) FLOATING POINT INTEGER. 0021 
» 0022 

* LANGUAGE - FAP# FORTRAN II FUNCTION 0023 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0024 
« STORAGE - 15 REGISTERS 0025 

* SPEED - 26 MACHINE CYCLES FOR RND 0026 

* AUTHOR - R.A. WISGINS, 15/9/62 0027 

* 0028 

* USAGE 0029 

« 0030 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0031 
» AND FORTRAN SYSTEM ROUTINES - NONE 0032 

* 0033 
» FORTRAN USAGE 0034 

* XI = RNDF(Y) 0035 

* X2 * RNDUPF(Y) 0036 

* X3 * RNDDNF(Y) 0037 
« 0038 
« INPUTS 0039 

* 0040 

* Y IS A FLOATING POINT NUMBER 0041 

* MUST BE LSTHN= 10.«*9 0042 

* 0043 

* OUTPUTS 0044 
» 0045 

* XI IS A FLOATING POINT INTEGER 0046 

* 0047 

* X2 IS A FLOATING POINT INTEGER 0048 

* 0049 

* X3 IS A FLOATING POINT INTEGER 0050 

* 0051 

* EXAMPLES 0052 
» 0053 

* 1. INPUT - Y=104.2 0054 

* OUTPUTS - Xl=104. X2=105. X3=104. 0055 

* 0056 

* 2. INPUT - Y=.5 0057 

* OUTPUTS - Xl = l. X2=l. X3=0. 0058 

* 0059 

* 3. INPUT - Y=~49.7 0060 
« OUTPUTS - Xi=-50. X2=-50. X3=-49. 0061 

* 0062 

* 4. INPUT - Y=1015. 0063 

* OUTPUTS - Xl=1015. X2=1015. X3=1015. 0064 

* 0065 
BCI 1 , RND 0066 

RNDUP TMI A 0067 

FAD =0177777777777 0068 

FAD =.5 0069 

RNDDN UFA =0233000000000 0070 

FAD =0233000000000 0071 

TRA 1,4 0072 

A FSB =0177777777777 0073 

FSB =.5 0074 
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• »•.»•••••»»••*»*•»»*•*•* 

(PAGE 2) 

TRA RNDDN 
RND TMI A+l 

TRA RNDUP+2 
END 



«»**«4»**«4* •*••»«*»•«•• 
* RND * 
*•*•••••»«••**••**«*«**• 
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0075 
0076 
0077 
0078 



**«••«***»*•»•*»»*•*••* 

RNDON ♦ 
***•»*«***««»**•*»»**#« 

REFER TO 
RND 



PROGRAM LISTINGS 



#*•♦**»«#»#»##*♦*»#»##*« 

# RNDON « 
#*#**##•«****•*»****»**« 

REFER TO 
RND 



*•••*»*•**•»«****•***#« 

RNDUP * 
••*»*»**•*«»***«»•***•• 

REFER TO 
RND 



*»**•«*•*****•»*»*****»» 

# RNDUP » 
*»**#« **««#•*•*«*«#*»*•* 

REFER TO 
RND 



*•*••»•**••*•**»•«*•••*« PROGRAM. LISTINGS #•#*####**♦#•##*♦#•*#*♦# 

* RNDV * 0 RNDV * 

*»•***•«***««**•*«**•#** **«*«»*«**»***•**»***»»* 



• 


RNDV 


{ SUBROUT INE) 


9/29/64 LAST CARD Iffl DECK 


IS NO. 0117 


• 


FAP 






0001 


•RNDV 








0002 




COUNT 


100 




0003 




LBL 


RNDV 




0004 




ENTRY 


RNDV <X,LX,XR) 




0005 




ENTRY 


RNDVUP <X,LX,XR) 




0006 




ENTRY 


RNDVDN <X,LX,XR) 




0007 


* 








0008 


* 




ABSTRACT — — 




0009 


• 








0010 


» TITLE - RNDV 


WITH SECONDARY ENTRIES 


RNDVUP AND RNDVDN 


0011 



ROUND, ROUND UP, OR ROUND DOWN A FLOATING VECTOR 

RNDV ROUNDS A FLTG VECTOR TO NEAREST FLTG INTEGERS. 

RNDVUP ROUNDS ELEMENTS OF A FLTG VECTOR TO LOWEST 
FLTG INTEGERS GRTHN= GIVEN ELEMENTS FOR PCSBTIVE 
ELEMENTS, OR TO GREATEST FLTG INTEGERS LSTHftl* GIVEN 
ELEMENTS FOR NEGATIVE ELEMENTS. 

RNDVDN ROUNDS ELEMENTS OF A FLTG VECTOR TO GREATEST 
FLTG INTEGERS LSTHN* GIVEN ELEMENTS FOR POSITIVE 
ELEMENTS, OR TO LOWEST FLTG INTEGERS GRTHN= GIVEN 
ELEMENTS FOR NEGATIVE ELEMENTS. 



LANGUAGE 

EQUIPMENT 

STORAGE 

SPEED 

AUTHOR 



OUTPUTS MAY REPLACE INPUTS 

FAP SUBROUTINES ( FORTRAN- I I COMPATIBLE) 
709 OR 7090 (MAIN FRAME ONLY) 
34 REGISTERS 

ABOUT 36 + 32*LX MACHINE CYCLES, LX=VECT0R LENGTH 
S.M. SIMPSON, AUGUST 1963 



TRANSFER VECTOR CONTAINS ROUTINES 
AND FORTRAN SYSTEM ROUTINES 

FORTRAN USAGE 

CALL RNDV <X,LX#XR) 

CALL RNDVUP(X,LX,XR) 

CALL RNDVDN<X,LX,XR) 



RND, RNDUP, RNDDN CFUNCTI0N51 
(NONE) 



» INPUTS 

* xm 
» 

» LX 
* 

» OUTPUTS 
* 

* XRU) 



1*1.. .LX IS ANY FLOATING VECTOR 
SHOULD EXCEED 0 

STRAIGHT RETURN WITH NO ACTION IF LX LSTHN 1 

1 = 1.. .LX IS XRU) = ROUNDED FORM OF XII) 

LET X= S*IXI+XF) WHERE S= + l. OR -1., XI IS POSITIVE 
LSTHN* XF LSTHN 1. 
S*XH I) IF XF=0. 



WHOLE NUMBER, ANO 0. 
THEN XRU) WILL ALWAYS 
OTHERWISE 

XRU) 

XRU) 



SMXIU)) 

s*(xn n + i.o) 
xru) = s*(xiun 

XRU) = S*< X I ( I ) + 1.0 ) 



FOR RNDVDN 
FOR RNDVUP 
IF XFU) LSTHN 
IF XFU) GRTHN* 



.5 
.5 



FOR RNOV 
FOR RNDV 



EQUIVALENCE(XR,X) IS PERMITTED 



* EXAMPLES 



* 1. INPUTS - XU...5) 



1.1, 2.2, -3.5, 4.7, 5.0 



XR4=0;0 



USAGE 



OUTPUTS - 



XR1U. 
XR2 ( 1. 
XR3U. 
XU) * 



CALL RNDV (X,5,XR1) 
CALL RNDVUP(X,5,XR2) 
CALL RNDVDN(X,5,XR3) 
CALL RNDV (X,l, X ) 
CALL RNDV (X,0,XR4) 
..5) = 1., 2., -4., 
.5) = 2., 3., -4., 
.5) = 1., 2., -3., 



5. 
5. 

5. 



1. 



XR4 = 0.0 {NO OUTPUT CASE) 



0012 
0013 
0014 
C015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 

0033 
0034 
0035 
0036 
C037 
0038 
0039 
0040 
0041 
0042 
0043 
C044 
0045 
0046 
0047 
C048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
006 7 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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• PROGRAM FOLLOWS BELOW 0075 

* 0076 

• 0077 

* TRANSFER VECTOR CONTAINS RND,RNDUP AND RNDDN FUNCTIONS 0078 
» 0079 





HTR 


0 


XR1 


0080 




HTR 


0 


XR4 


0081 




BCI 


1, RNDV 




0082 


* PRINCIPAL 


ENTRY. RNDV(X 


♦LX,XR) 


0083 


RNDV 


CLA 


R 




0084 


SETUP 


STO 


ROUND 




0085 




SXD 


RNDV-2*4 




0086 




SXD 


RNDV-3U 




0087 


Kl 


CLA 


1*4 




0088 




ADD 


Kl 


A(X)+l 


0089 




STA 


GET 




0090 




CLA 


3,4 




0091 




ADD 


Kl 


A(XR}+1 


0092 




STA 


STORE 




0093 




CLA* 


2,4 


LX 


0094 




TMI 


LEAVE 




0095 




PDX 


0,1 




0096 




TXL 


LEAVE, 1,0 




0097 


* LOOP 








0098 


GET 


CLA 


**,1 


*«=A(X)+1 


0099 


ROUND 


TSX 


**,4 


**=$RND,$RNDUP, OR $RNDDN 


0100 


STORE 


STO 


»*,1 


**=A(XR)4-1 


0101 




TIX 


GET, 1,1 




0102 


* EXIT 








0103 


LEAVE 


LXD 


RNDV-2,4 




0104 




LXO 


RNDV-3,1 




0105 




TRA 


4,4 




0106 


♦ SECOND ENTRY. RNDVUP(X, 


LX,XR) 


0107 


RNDVUP 


CLA 


RUP 




0108 




TRA 


SETUP 




0109 


* THIRD ENTRY, RNDVDN ( X ,LX ,XR ) 


0110 


RNDVDN 


CLA 


RON 




Olll 




TRA 


SETUP 




0112 


* CONSTANTS 






0113 


R 


TSX 


$RND,4 




0114 


RUP 


TSX 


$RNDUP#4 




0115 


RON 


TSX 
END 


SRNDDNf 4 




0116 
0117 



••***• •**•••*•••**•**»** 

# RNDVON ♦ 

• *•*#*••*****•*•**•»*•*** 

REFER TO 
RNDV 



PROGRAM LISTINGS 



#•*#.*******«•****•••»•«* 
* RNDVON « 
4 ••#«*• ••**•*« •»«****•«« 

REFER TO 
RNOV 



************************ 

« RNDVUP * 



REFER TO 
RNDV 



PROGRAM LISTINGS 



4*4t#*«*4 ********* ******* 

* RNDVUP * 

-#******* **•*•«* **»**•**« 

REFER TO 
RNDV 
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» ROAR2 * * ROAR2 * 

•••»***••#••»***#•**»»•» *»*#♦»»»•»#**##»***#**»# 



ROAR2 (SUBROUTINE) 9/10/64 LAST CARD IN OEGK IS NO* 0113 

LABEL 0001 



CR0AR2 0002 

SUBROUTINE R0AR2 < J0B,XA,N,M,XRA) 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - R0AR2 0007 

C ROTATE CENTRO-SYMMETRIC OR ANTISYMMETRIC 2-DIMENSI0NAL ARRAY 0008 

C 0009 

C R0AR2 ROTATES HALF OF A CENTRO-SYMMETR ICt OR ANTISYM- 0010 

C METRIC 2-D I MENS I ONAL ARRAY BY 90 DEGREES. THUS* IF WE 0011 

C ARE GIVEN HALF OF AN ARRAY XII, J) I=-N,*.WN J*0#.**,M 0012 

C THAT IS STORED BY COLUMNS AS 0013 

C 0014 

C X<N,0) X(Ntl) X(N,2) . . X<N,M) 0015 

C . . . . 0016 

C ... . 0017 

C X{0,0) X(0,1) XC0,2) . . XI0,M) 0018 

C ... . 0019 

C ... . 0020 

C X<-N,0) X(-N,l) X(-N,2) . . X(-N,M! 0021 

C 0022 

C THEN R0AR2 ROTATES THE TERMS SO THAT THEY ARE STORED BY 0023 

C COLUMNS AS 0024 

C 0025 

C X(M,0) X(M,1) X{M,2) . . X<M,N) 0026 

C ... . 0027 

C ... . 0028 

C X<0,0) X(0,1) X<0,2) . . X{0,N) 0029 

C ... . 0030 

C ... . 0031 

C X<-M,0) X(-M,l) X(-M,2) . . X(-M,N) 0032 

C 0033 

C LANGUAGE - FORTRAN II SUBROUTINE 0034 

C EQUIPMENT - 709, 7090, 7094 ( MAIN FRAME ONLY) 0035 

C STORAGE - 174 REGISTERS 0036 

C SPEED - ABOUT .000017*M«N**2 + »000012*N**2 + .00021*M*N 0037 

C ♦ .00070*N ♦ .00012*M ♦ .00115 SECONDS 0038 

C ON THE 7094 MOD 1 . 0039 

C AUTHOR - R.A. WIGGINS, JUNE, 1963 0040 

C 0041 

C USAGE 0042 

C 0043 

C TRANSFER VECTOR CONTAINS ROUTINES - MATRA,MOVREV,REVERS 0044 

C AND FORTRAN SYSTEM ROUTINES - NONE 0045 

C 0046 

C FORTRAN USAGE 0047 

C CALL R0AR2 ( JOB, XA,N,M,XRA) 0048 

C 0049 

C INPUTS 0050 

C 0051 

C JOB =1 INDICATES XA IS CENTRO— SYMMETRIC. 0052 

C =-1 INDICATES XA IS CENTRO-ANT I SYMMETR IC. 0053 

C 0054 

C XAU) I = 1,...,<N+N+1)*1M + 1) CONTAINS X(J,K) J*-N,..*,N f 0055 

C K=0,...,M AS DEFINED IN THE ABSTRACT* 0056 

C 0057 

C N MUST BE GRTHN 0 0058 

C 0059 

C M MUST BE GRTHN- 0 0060 

C 0061 

C OUTPUTS 0062 

C 0063 

C XRA(I) I=l,...,iM+M+l)*(N+l) CONTAINS XIK,J) K*-M,...,M# 0064 

C J=0,*..,N AS DEFINED IN THE ABSTRACT. 0065 

C EQUIVALENCE WITH XA IS PERMITTED. 0066 

C 0067 

C EXAMPLES 0068 

C 0069 

C 1. INPUTS - N=2 M*3 XAU...20) * 2. C, 1.0,5.0, 1.0,2.0, 0070 

C J0B=1 2.1,1.1,0.1,-1.1,-2.1, 0071 

C 2.2,1.2,0.2,-1.2,-2.2, 0072 

C 2.3,1.3,0.3,-1.3,-2.3 0073 
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C OUTPUTS - XRA(1...21) « 0. 3, 0.2, 0. 1, 5.0, O.i, 0«I2, 0;3, 0074 

C 1.3, 1.2, 1.1, 1.0,-1. 1,-1. 2*-l*3» 0075 

C 2.3,2.2,2.1,2.0,-2.1,-2.21-2-3 0076 

C 0077 

C 2. INPUTS - N*2 M*3 XA(1..*20) « 2.0,1.0,0.0,-1.0,-2.0, 0078 

C J0B=-1 2.1,1.1,0.1,-1.1,-2*1, 0079 

C 2.2,1.2,0.2,-1.2,-2.2, 0080 

C 2.3,1.3,0.3,-1.3,-2.3 0081 

C OUTPUTS - XRAC1...21) = 0.3,0.2,0.1,0.0,-0.1,-0.24-0.3, 0082 

C 1.3,1.2,1.1,1.0, l.l, 1.21 1.3, 0083 

C 2.3,2.2,2.1,2.0, 2.1, 2.2, 2.3 0084 

C 0085 

C 0086 

C PROGRAM FOLLOWS BELOW 0087 

C 0088 

DIMENSION XA(2)#XRAC2) 0089 

NN=N 0090 

MM=M 0091 

NRB-NN+NN+l 0092 

NCB=MM+1 0093 

NRA=NCB+MM 0094 

NCA=NN+l 0095 

LXB=NRB*NCB 0096 

LXA=NRA*NCA 0097 

CALL MATRA ( XA,NRB,NCB, XRA) 0098 

IF=1 0099 

IL^LXB+1 0100 

LRO-LXB 0101 

1000 Z*0. 0102 
DO 10 1=1, NCA 0103 
IF1=IF+MM 0104 
CALL MOVREV ( LRO, 1 , XRA( I F ) , 1 , XRA( IF 1 » , 1) 0105 
CALL riuvtsEV i HH « i , XRAi I L t ir # , Jud) Oiuo 

1001 Z=l. 0107 
IF^IF+NRA 0108 
IL=IL-1 0109 

10 LR0=LR0— NRA— 1 0110 

CALL REVERSf>LXA#XRA) 0111 

RETURN 0112 

END 0113 
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* ROTATl ISUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO, 0109 

* FAP OOOi 
♦ROTATl 0002 

COUNT 100 0003 

LBL ROTATl 0004 

ENTRY ROTATl { X , NX , NUP, ROTX ) 0005 

» 0006 

* ABSTRACT 0007 

« 0008 

* TITLE - ROTATl 0009 

* ROTATE A VECTOR UPWARDS OR DOWNWARDS AN ARBITRARY AMOUNT 0010 
» 0011 

* ROTATl ROTATES A VECTOR UPWARDS OR DOWNWARDS A PRESCRIBED 0012 
» NUMBER OF UNITS SUCH THAT ELEMENTS SHIFTED OUT OF ONE END 0013 

* ARE ROTATED INTO THE OPPOSITE END. IT IS IMMATERIAL 0014 
« WHETHER THE VECTOR IS FIXED POINT OR FLOATING POINT. THE 0015 

* ROTATION IS ACCOMPLISHED IN ONE PASS OF THE VECTOR RATHER 0016 
» THAN BY SUCCESSIVE SHIFTING. OUTPUT ON TOP OF fNPUT IS 0017 
» PERMITTED. 0018 

* 0019 
» LANGUAGE - FAP SUBROUTINE I FORTRAN— 1 1 COMPATIBLE) 0020 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0021 
» STORAGE - 46 REGISTERS 0022 

* SPEED - TAKES (12 TO 18) * VECTOR LENGTH MACHINE CYCLES ON 7090 0023 

* AUTHOR - R.A. WIGGINS AND J .CLARK* JUNE 1962 0024 
» 0025 

* USAGE 0026 

* 0027 
» TRANSFER VECTOR CONTAINS ROUTINES - NONE 0028 

* AND FORTRAN SYSTEM ROUTINES - NONE 0029 

* 0030 

* FORTRAN USAGE 0031 
» CALL ROTATl (X, NX, NUP, ROTX) 0032 

* 0033 
» INPUTS 0034 

* 0035 
« XU) 1 = 1,... ,NX IS THE VECTOR TO BE ROTATED. 0036 
« (NOTE - X MAY BE EITHER FIXED OR FLOATING POINT WITHOUT 0037 

* MODIFICATION TO THE PROGRAM). 0038 

* 0039 

* NX IS THE LENGTH OF THE X VECTOR. 0040 

* MUST HAVE VALUE 1 OR GREATER (STRAIGHT EXIT OTHERWISE} 0041 

* 0042 

* NUP IS THE NUMBER OF REGISTERS X IS TO BE ROTATEO. 0043 

* ( UPWARDS IF NUP POSITIVE) 0044 

* 0045 

* OUTPUTS 0046 

* 0047 

* ROTX(I) 1=1,... ,NX IS THE VECTOR ROTATED SUCH THAT 0048 

* ROTXCI)=X(U-NUP)MODULO NX). 0049 
» (NOTE - THE EQUIVALENCE OF ROTX( 1) WITH X(l) IS 0050 

* PERMITTED). 0051 

* 0052 

* EXAMPLES 0053 

* 0054 

* 1. INPUTS - XU...5) = 4.,6.,3.,9.,1. NX=5 NUP=8 0055 

* OUTPUTS - R0TXU...5) = 3 . , 9 . , 1. , 4. , 6. 0056 

* 0057 

* 2. INPUTS - X(l...5) = 4. ,6.,3.,9.,1. NX = 5 NUP=-i 0058 

* USAGE - CALL ROTATl ( X, NX, NUP, X) 0059 
» OUTPUTS - XU...5) = 6.,3.,9.,l.,4. 0060 

* 0061 

* PROGRAM FOLLOWS BELOW 0062 

* 0063 
XR1 HTR 0 0064 
XR4 HTR 0 0065 

BCI 1, ROTATl 0066 

ROTATl SXD XR4,4 0067 

SXD XRl,l 0068 

CAL 1,4 =ADR(X) 0069 

ADD = 1B35 0070 

STA X 0071 

CAL 4,4 =ADR(XR) 0072 

ADD =1835 0073 

STA XR 0074 
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CLA» 


2,4 


-LX 




UU f 3 




TZE 


EX I T 






0076 




TMI 


EXIT 






0077 




PDX 








nn7ft 

UU f O 




TXI 


w ~ i. , L , L 






UU « V 




STO 


LX 






uuo u 




STD 


T2 






UUO 1 




LDQ* 


3,4 


-NUP 




0082 




ZAC 








0083 




LLS 


o 






0084 




DVP 


LX 






0085 




TPL 


*+ 2 






uuoo 




ADD 


LA 






UUo f 




STD 


Jl 






0088 




AXT 


1,4 






008 9 




SXD 


T3 ,4 






0090 




CLA* 


x 






009 1 




TRA 


x 






0092 


Tl 


TXI 


*+ 1 , 4 , ♦ * 




1 X 1+1 X .1 X) 

LA jTtAf LA / 


0093 


T2 


TIX 




* *= L X 




0094 




XCA 








0095 


x 


LDQ 


»* .4 


##= AnR ( X ) + 1 




0096 


XR 


c Tn 
b 1 U 


**,4 


**— AUK I XK J ▼ 1 




0097 


T4 


TIX 


Tl # I , 1 






0098 


EXIT 


LXD 


XR1 ,1 






0099 




LXD 


XR4,4 






oioo 




TRA 


5,4 






0101 


T3 


TXH 


T2+l,4,*» 


**=FIRST VALUE 


OF LOOP 


0102 




STQ» 


XR 






0103 




TXI 


•+1,4,1 






0104 




SXD 


T3,4 






0105 




LDQ* 


X 






0106 




TO A 










LX 


PZE 








0108 




END 








0109 
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* RPLFMT ( SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0084 

* FAP 0001 
♦RPLFMT 0002 

COUNT 100 0003 

LBL RPLFMT 0004 

ENTRY RPLFMT (FMT, FMTNEW) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 
« TITLE - RPLFMT 0009 

* REPLACE THE FORMAT OF A SUCCEEDING INPUT OR OUTPUT STATEMENT 0010 

* 0011 
» RPLFMT HAS TWO ARGUMENTS FMT AND FMTNEW. RPLFMT ASSUMES 0012 

* THAT SHORTLY BELOW THE CALL RPLFMT STATEMENT THERE 0013 
» APPEARS AN INPUT OR OUTPUT STATEMENT USING THE FORMAT 0014 

* FMT. THIS STATEMENT IS FOUNO AND THE FORMAT FMTNIW IS 0015 

* SUBSTITUTED FOR FMT. 0016 

* 0017 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN- 1 1 COMPATIBLE) 0018 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0019 

* STORAGE - 17 REGISTERS 0020 

* SPEED - 0021 

* AUTHOR - S.M. SIMPSON JR., SEPTEMBER 1963 0022 

* 0023 
» USAGE 0024 

* 0025 
» TRANSFER VECTOR CONTAINS ROUTINES - < NONE ) 0026 
« AND FORTRAN SYSTEM ROUTINES - < NONE ) 0027 

* 0028 

* FORTRAN USAGE (ILLUSTRATIVE) 0029 
» 0030 

* CALL RPLFMT (FMTfFMT NEW) 0031 

* 0032 

* (THEN ANY AMOUNT OF PROGRAM NOT INVOLVING 0033 

* INPUT OR OUTPUT ACCORDING TO FORMAT FMT) 0034 

* 0035 
» WRITE OUTPUT TAPE 2, FMT, LIST 0036 

* 003 7 
» LIST WILL BE PRINTED ACCORDING TO FORMAT FMTNEW RATHER THAN FMT* 0038 

* 0039 

* CAUTION - THE CHANGE INDUCED BY RPLFMT (PZE FMT IS REPLACED BY 0040 

* PZE FMTNEW) IS PERMANENT. IF REPEATED USE OF THE SAME 0041 

* SEQUENCE IS DESIRED USING DIFFERENT FMTNEW VALUES, THE 0042 
» ORIGINAL FMT SHOULD BE RESTORED BY A SCHEME SUCH AS 0043 

* CALL RPLFMT (FMT, FMTNEW) 0044 

* GO TO 20 0045 
» 10 CALL RPLFMT ( FMTNEW, FMT) 0046 
» GO TO 30 0047 

* 20 WRITE OUTPUT TAPE 2, FMT, LIST 0048 

* GO TO 10 0049 

* 30 CONTINUE 0050 

* 0051 

* EXAMPLES 0052 

* 0053 

* 1. INPUTS - X * 3.14159 FMT( 1 )=4H{ 1 7 ) 0054 

* FMTNEWU...3) » 14H(5H X « ,F9.5) 0055 
» USAGE - DIMENSION FMT ( 1 ) ,FMTNEW( 3) 0056 

* CALL RPLFMT ( FMT, FMTNEW) 0057 

* WRITE OUTPUT TAPE 2,FMT,X 0058 

* OUTPUTS - X » 3.14159 IS PRINTED OFFLINE FROM LOGICAL TAPE 2* 0059 

* 0060 

* PROGRAM FOLLOWS BELOW 0061 

* 0062 

* 0063 

* NO TRANSFER VECTOR 0064 

HTR 0 XR4 0065 

BCI 1, RPLFMT 0066 

* ONLY ENTRY. RPLFMT (FMT, FMTNEW ) 0067 
RPLFMT SXD RPLFMT-2,4 0068 

CLA 2,4 A( FMTNEW) 0069 

STA PZEA 0070 

LDQ PZEA MQ HAS REPLACEMENT SETTING 0071 

CLA 1,4 A ( FMT ) 0072 

STA PZEA PZEA HAS OLD SETTING 0073 

* COMPARE LOOP 0074 
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CAL 


4,4 


(FIRST POSSIBILITY) 


0075 


LAS 


PZEA 




0076 


TRA 


*+2 




0077 


TRA 


SET 


GOT IT 


0078 


TXI 


CAL, 4,-1 


TRY AGAIN 


0079 


STQ 


4,4 




0080 


LXD 


RPLFMT-2,4 




0081 


TRA 


3,4 




0082 


PZE 


»» 


** = A(FMTNEW) THEN ACFMT) 


0083 


END 






0084 
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* RSKIP (SUBROUTINE) 9/29/64 LAST CARD IN DICK IS NO. 0089 

* FAP OOOi 
♦RSKIP 0002 

COUNT 100 0003 

LBL RSKIP 0004 

ENTRY RSKIP C NT APE, NRECS, EOF ) 0005 

» 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - RSKIP 0009 

* SKIP FORWARD OR BACKWARD OVER RECORDS ON TAPE 0010 

* 0011 

* RSKIPS SKIPS AN ARBITRARY NUMBER OF RECORDS FORWARD OR 0012 
» BACKWARD ON A TAPE. END FILES ARE CHECKED FOR WHILE 0013 
» SKIPPING FORWARD BUT NOT WHILE SKIPPING BACKWARDS- 0014 

* 0015 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0016 
« EQUIPMENT - 709 OR 7090 (MAIN FRAME PLUS I TAPE UNIT) 0017 
» STORAGE - 37 REGISTERS 0018 

* SPEED - .0085 SEC PER 80~CHARACTER, HIGH-DENSITY RECORD - 0019 

* FORWARD SKIPPING. 0020 
» - .0378 SEC PER 80— CHARACTER, HIGH-DENSITY RECORD - 0021 
» BACK SKIPPING. 0022 
» AUTHOR - R.A. WIGGINS DEC » 1962 0023 
« 0024 

* USAGE 0025 

* 0026 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0027 

* AND FORTRAN SYSTEM ROUTINES - ( IDS ) , ( TRC ) , ( TCO ) , ( TEF ) 4 t RDS I » 0028 

* (BSR) 0029 

* 0030 

* FORTRAN USAGE 0031 

* CALL RSKIP (NTAPEtNRECStEOF) 0032 

* 0033 

* INPUTS 0034 

* 003 5 

* NTAPE IS LOGICAL TAPE NUMBER OF THE TAPE THAT IS TO BE SPACED^ 0036 

* IS FOR IRAN II INTEGER 0037 
» 0038 
» NRECS IS THE NUMBER OF PHYSICAL RECORDS TO BE SKIPPED. 0039 

* IF GRTHN 0 THE TAPE IS MOVED AWAY FROM THE BEGINNING 0040 
» POINT. 0041 

* IF = 0 THE TAPE IS NOT MOVED. 0042 

* IF LSTHN 0 THE TAPE IS MOVED TOWARD THE BEGINNING POINT. 0043 
« IS FORTRAN II INTEGER. 0044 

* 0045 

* OUTPUTS THE TAPE IS MOVED. 0046 

* 0047 
« EOF =1. IF AN END FILE WAS ENCOUNTERED DURING SKIPPING 0048 

* FORWARD. 0049 

* =0. IF NO END FILE WAS ENCOUNTERED OR NRECS LSTHN 0* 0050 

* (END FILES ARE NOT DETECTED DURING BACKSPACING) 0051 

* 0052 
» WHETHER SKIPPING FORWARD OR BACKWARD* EACH END-OF-F ILE 0053 
» ENCOUNTERED COUNTS AS ONE RECORD. 0054 

* 0055 

* 0056 

* PROGRAM FOLLOWS BELOW. 0057 
» 0058 

HPR 0 0059 

BCI 1, RSKIP 0060 

RSKIP SXD *-2,4 SAVE INDEX. 0061 

CLA* 1,4 GET LOGICAL TAPE NO. 0062 

TSX $UGS)#4 SET UP (IOS). 0063 

LXD RSKIP-2,4 RESET INDEX 4. 0064 

STZ* 3,4 CLEAR EOF INDICATOR. 0065 

CLA* 2,4 GET NO OF RECORDS. 0066 

TZE 4,4 EXIT IF ZERO. 0067 

PDX ,4 SAVE. 0068 

LDQ* $(TRC) SET UP 0069 

SLQ TRC REDUNDANCY CHECK, 0070 

LDQ* $(TCO) 0071 

SLQ TCO CHANNEL IN OPERATION, 0072 

LDQ* $ ( TEF ) AND 0073 

SLQ TEF END FILE TRANSFERS. 0074 
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TUT 

1 rl 1 


M T 

PI 1 




UU 1 D 


cnou 
rUnn 


vrr « 






UU f o 




T T V 
1 1 A 


t A 1 

* 1 , I 




UU f f 




L au 


DC If I D— 1> A 


D CC CTT TO A 
K to t 1 IK t • 


UU f o 


Trn 


Trn a 




nPl AV IIMTTI TADC CTnDC 
UCLAT U!N 1 1L 1 Arc o 1 U r o • 


UU f 7 


TRC 


TRCA 


*+l 


TURN OFF REDUNDANCY CHECK LIGHT. 


0080 


TEF 


TEFA 


♦+2 


CHECK END FILE. 


0081 




TRA 






0082 




CLA 


= 1. 




0083 




STO» 


3,4 




0084 




TRA 


4,4 




0085 


MI 


XEC* 


$(BSR) 




0086 




TIX 


*-l,4,l 




0087 




TRA 


TCO-1 




0088 




END 






0089 
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* RVPRTS * * RVPRTS * 

»****«»«•»*««**#***••*»* *■ »»•»*******»** **♦«#»»** 

REFER TO REFER TO 

CHPRTS CHPRTS 



«»•*****••••»****•**«•»* PROGRAM LISTINGS 

» SAME » * SAME » 

•**»••»***«***•*••*»*••» 4 **#*##*»4*»*-f *«»****•«* 

* SAME (FUNCTIONS 9/29/64 LAST CARD IN DECK IS NO. 0039 
» FAP 0001 
•SAME 0002 

COUNT 45 0003 

LBL SAME 0004 

ENTRY SAME F(IXl) 0005 

ENTRY XSAME F( XI) 0006 

* 0007 

* — > — ABSTRACT 0008 

* 0009 

* TITLE - SAME , WITH SECONDARY ENTRY POINT XSAME 0010 
» ENABLE MIXED EXPRESSIONS IN FORTRAN 0011 

* 0012 

* SAME AND XSAME ARE FUNCTIONS WHICH DO NOTHING BBIT RETURN 0013 

* TO THE CALLING PROGRAM. THIS ALLOWS THE USE OF MIXED 0014 

* EXPRESSIONS IN FORTRAN. FOR EXAMPLE* THE FIXED POINT 0015 
« ADDITION OF TWO WORDS (CALLED X AND Y) WITH FLOATING 0016 

* POINT NAMES IS ACCOMPLISHED BY 0017 

* 0018 
» ISUM = XSAMEF(X) + XSAMEF(Y) 0019 
» 0020 
» LANGUAGE - FAP, FUNCTION (FORTRAN II COMPATIBLE) 0021 
» EQUIPMENT - 704, 709, OR 7090 (MAIN FRAME ONLY) 0022 

* STORAGE - 1 CELL 0023 

* SPEED - 2 MACHINE CYCLES 0024 

* AUTHOR ~ J.F. CLAERBOUT 0025 

* 0026 
» — — USAGE — — 0027 
« 0028 
» TRANSFER VECTOR CONTAINS ROUTINES - NONE 0029 

* AND FORTRAN SYSTEM ROUTINES - NONE 0030 
« 0031 
» fuRTRAiN uS«Gc uu^^ 
» XI = SAMEF(IXl) 0033 
» IXl = XSAMEF(Xi) 0034 

* 0035 

* 0036 
XSAME BSS 0 0037 
SAME TRA 1,4 0038 

END 0039 
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****•*••»***•*•••«•****• 
# SEARCH • 
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* SEARCH I SUBROUTINE) 9/29/64 LAST CARD IN DECK IS HQ* 0094 
» FAP 0001 
•SEARCH 0002 

COUNT 75 0003 

LBL SEARCH 0004 

ENTRY SEARCH ( LV, VECTOR, XNUM, INDEX) 0005 

* 0006 

« ABSTRACT 0007 

« 0008 

» TITLE - SEARCH 0009 

» SEARCH A VECTOR FOR A VALUE 0010 

* 0011 
« SEARCH A VECTOR OF FIXED* FLOATING OR LOGICAL NUMBERS 0012 
« FOR A PARTICULAR NUMBER. IF THIS NUMBER IS FOUND* ITS 0013 
» INDEX IN THE VECTOR IS RETURNED, IF IT IS NOT FOUND, A 0014 

* ZERO IS RETURNED AS THE INDEX. 0015 
» 0016 

* LANGUAGE - FAP , SUBROUTINE (FORTRAN II COMPATIBLE) 0017 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0018 

* STORAGE - 25 REGISTERS 0019 

* SPEED - LESS THAN (30 + 8*LENGTH OF LIST) MACHINE CYCLES 0020 

* AUTHOR -» R. A. WIGGINS, 16/7/62 0021 

* 0022 

« — USAGE 0023 

» ' 0024 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0025 

* AND FORTRAN SYSTEM ROUTINES - NONE 0026 

* 0027 
» FORTRAN USAGE 0028 

* CALL SE ARCH CLV, VECTOR, XNUM, INDEX ) 0029 

* 0030 
» INPUTS 0031 

* 0032 

* VECTOR(I) I«l...LV IS A - VECTOR OF FLOATING, FIXED, OR H@HL.LERI TH 0033 

* NUMBERS 0034 
» 0035 

* LV IS FORTRAN II INTEGER 0036 

* MUST BE GRTHN=0 0037 
» 0038 

* XNUM IS A NUMBER OF SAME MODE AS VECTOR 0039 
» 0040 

* OUTPUTS 0041 

* 0042 

* INDEX INDEX OF XNUM IN VECTOR* I.E. VECTOR! INDEX1 = XNUM 0043 

* =0 IF XNUM IS NOT CONTAINED IN VECTOR 0044 

* =0 IF LV=0 0045 
» 0046 
« EXAMPLES 0047 

* 0048 

* I. INPUTS - VECT0RC1...5)=1.,3.,2.5,4.,4.1 LV=5 XNUM*2.5 0049 

* OUTPUTS - IN0EX=3 0050 

* 0051 

* 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT XNUM=5. 0052 
» OUTPUTS - INDEX^O 0053 
» 0054 
« 3. INPUTS - VECT0RU..*5) = MLI1, 4,7*11, 9 LV=5 XNUM*MLfll 0055 

* OUTPUTS - INDEX=4 0056 

* 0057 

* 4. INPUTS - VECT0R11...3)=6HA1 ,A2 ,B LV=3 XNUM«6HA1 0058 

* OUTPUTS - INDEX=1 0059 

* 0060 

* 5. INPUTS - VECT0Rtl...2)=l.,2. LV=0 XNUM*1. 0061 
» OUTPUTS - INDEXED 0062 
» 0063 

* 6. INPUTS - VECTCRtl...5)=MLIl,2,5,2,3 LV=5 XNUM*MLI 2 0064 
» OUTPUTS - INDEX=2 0065 

* 0066 

* 7. INPUTS - VECT0R11)=MLI 1 LV=1 XNUM=MLI 1 0067 

* OUTPUTS - INDEX=1 0068 

* 0069 
HTR 0 0070 
BCI 1, SEARCH 0071 

SEARCH SXD *-2,4 0072 

SXA ADR , 1 0073 

CLA* 1,4 0074 
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TZE 


ADR-1 


0075 




STD 


A 


0076 




CAL 


2,4 


0077 




ADD 


= 1835 


0078 




STA 


DATA 


0079 




CAL 


3,4 


0080 




STA 


ITEM 


0081 




AXT 


1,1 


0082 


DATA 


CLA 


»*,1 


0083 


ITEM 


SUB 


*» 


0084 




TZE 


ADR+2 


0085 




TXI 


A, 1,1 


0086 


A 


TXL 


DATA,1,«* 


0087 




STZ» 


4,4 


0088 


ADR 


AXT 


»*,1 


0089 




TRA 


5,4 


0090 




PXD 


,1 


0091 




STO* 


4,4 


0092 




TRA 


ADR 


0093 




END 




0094 
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» SEQSAC ( SUBROUTINE) 9/8/64 LAST CARD IN DECK IS NO* 0277 

» FAP 0001 

•SEQSAC 0002 

COUNT 300 0003 

LBL SEQSAC 0004 

ENTRY SEQSAC (ARGLO, ARGDEL) 0005 

ENTRY NEXCOS F C DUMMY ) 0006 

ENTRY NEXSIN F i DUMMY ) 0007 

* 0008 
» 0009 

* ABSTRACT — *~ 0010 

* 0011 

* TITLE - SEQSAC, WITH SECONDARY ENTRIES NEXCOS AND NEXSIN (FUNCTIONS! 0012 
» FAST FUNCTIONS FOR SEQUENTIAL SINES AND COSINES 0013 

* 0014 

* SEQSAC, NEXCOS, AND NEXSIN ARE A PROGRAM SET FOR 0015 

* PROVIDING A SUCCESSION OF SINE AND/OR COSINE VALUES AT 0016 

* HIGH SPEED, APPLICABLE IN CASES WHERE THE SUCCESSIVE 0017 

* ARGUMENT VALUES DIFFER BY A CONSTANT, SPEED IS ATTAINED 0018 

* BY THE USE OF SUM ANGLE FORMULAS, AND ERROR GROWTH IS 0019 

* LIMITED BY AUTOMATIC RESETTING EVERY HUNDREDTH ARGUMENT* 0020 

* 0021 
» THE ENTRY SEQSAC IS USED ONCE TO INITIALIZE FOR THE 0022 

* DESIRED BASE VALUE AND INCREMENTAL VALUE OF TH6 ARGUMENT* 0023 

* THEREAFTER NEXCOS AND/OR NEXSIN ARE USED IN LOOP 0024 
» FASHION AS FUNCTIONS (WITH DUMMY ARGUMENTS) TO PROVIDE 0025 

* THE SUCCESSIVE VALUES. 0026 

* 0027 
» LANGUAGE - FAP SUBROUTINE AND FUNCTIONS ( FORTRAN— 1 1 COMPATIBLE I 0028 

* EQUIPMENT - 709,7090,7094 (MAIN FRAME ONLY) 0029 

* STORAGE - 94 REGISTERS 0030 

* SPEED - THE INITIALIZING CALL OF SEQSAC TAKES ABOUT 80 MACHINE 0031 

* CYCLES CON THE 7090) PLUS FOUR USES OF THE FORTRAN 0032 
» SYSTEM FUNCTIONS COS AND SIN. 0033 
» THEREAFTER EACH SINE OR COSINE VALUE TAKES ABO^T 0034 
» 110 MACHINE CYCLES IF THE SUBSEQUENT LOOP USES ONLY 0035 
» NEXCOS OR NEXSIN, 0036 
» OR 0037 

* 60 MACHINE CYCLES IF THE SUBSEQUENT LOOP USfS BOTH 0038 

* NEXCOS AND NEXSIN. 0039 
» AUTHOR - S.M. SIMPSON, JUNE 1964 0040 
» 0041 

* 0042 

* USAGE 0043 

» 0044 

» TRANSFER VECTOR CONTAINS ROUTINES - NOT ANY 0045 

» AND FORTRAN SYSTEM ROUTINES - COS, SIN 0046 

* 0047 

* ILLUSTRATIVE FORTRAN USAGE 0048 

* 0049 
» CALL SEQSACC ARGLO, ARGDEL) 0050 

* DO 10 1=1, N 0051 

* CU) = NEXCOSF ( DUMMY ) 0052 

* 10 S(I) = NEXS I NF ( DUMMY ) 0053 

* 0054 
» OR 0055 
» 0056 

* CALL SEQSAC t ARGLO, ARGDEL) 0057 
» DO 10 1=1, N 0058 

* SCI) * NEXSl NF ( DUMMY ) 0059 

* 10 CU) = NEXCOSF (DUMMY) 0060 

* 0061 

* OR 0062 

* 0063 

* CALL SEQSAC ( ARGLO, ARGDEL) 0064 
» DO 10 1=1, N 0065 

* 10 CU) * NEXCOSF ( DUMMY ) 0066 

* 0067 

* v OR 0068 

* 0069 

* CALL SEQSACC ARGLO, ARGDEL) 0070 

* DO 10 1=1, N 0071 
» 10 SU) * NEXS INF (DUMMY) 0072 

* 0073 

* 0074 
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(PAGE 2) (PAGE 2) 

» INPUTS TO SEQSAC 0075 

• 0076 

• ARGLO IS THE ARGUMENT VALUE, IN RADIANS, OF THE FIRST COSINE 0077 

• ANO/OR SINE TO BE COMPUTED BY THE SUBSEQUENT USE OF 0078 

• NEXCOS ANO/OR NEXSIN. 0079 
» 0080 
» ARGDEL IS THE INCREMENT, IN RADIANS, BETWEEN SUCCESSIVE 0081 

• ARGUMENT VALUES. 0082 

• 0083 
« 0084 

• OUTPUTS FROM SEQSAC - NONE, ITS FUNCTION IS MERELY TO INITIALIZE 0085 
» NEXCOS AND NEXSIN. 0086 

• 0087 

• 0088 

• INPUTS TO NEXCOS AND NEXSIN 0089 

• 0090 

• DUMMY IS THE NAME OF A DUMMY VARIABLE NOT USED BY NEXCOS OR 0091 

• NEXSIN . ITS PURPOSE IS TO SATISFY THE FORTRAN 0092 

• REQUIREMENT THAT EVERY FUNCTION MUST HAVE AT LEAST ONE 0093 

• ARGUMENT. 0094 

• 0095 

• 0096 
« OUTPUTS FROM NEXSIN AND NEXCOS 0097 

• 0098 

• IF NEXSIN AND/OR NEXCOS ARE USED WITHOUT A PRIOR CALL 0099 

• OF SEQSAC, THE VALUES GENERATED WILL BE ZfRO. 0100 

• OTHERWISE, ON THE I-TH USE, SUBSEQUENT TO A CALL 0101 

• SEQSAC STATEMENT, OF NEXCOS AND/OR NEXSIN WE HAVE 0102 

• 0103 

• NEXCOSF HAS VALUE = COS ( ARGLO+( I— l)*ARGDEL) 0104 

• 0105 

• NEXSINF HAS VALUE * S IN( ARGLO* ( 1-1 ) * ARGDEL ) 0106 
- Glut 
« 0108 

• EXAMPLES 0109 

• 0110 
» 1. INPUTS - ARGLO * 0.0 ARGDEL * 3.14159265/6.0 (30 DEGREES) 0111 

• USAGE - CALL SEQSAC ( ARGLO, ARGDEL ) 0112 

• DO 10 1=1,202 0113 
» C(I) = NEXCOSF(DUMMY) 0114 
» 10 S(I) = NEXS INF ( DUMMY ) 0115 

• OUTPUTS - CU...202) * i.,.866, .5,0., 5,-. 866,-1. 866^ . i 0116 

• -.5,0. 0117 

• S<1.*.202> » 0., .5, .866, 1., .866, . 5 , 0. ,~ . 5 , . . J , 0118 

• -.866,-1. 0119 

• 0120 

• 2. INPUTS - SAME AS EXAMPLE 1. 0121 

• USAGE - SAME AS EXAMPLE 1. EXCEPT THE LAST TWO STATEMENTS ARE 0122 

• EXCHANGED. 0123 

• OUTPUTS - SAME AS EXAMPLE 1. 0124 
» 0125 
» 3. INPUTS - SAME AS EXAMPLE 1. 0126 

• USAGE - SAME AS EXAMPLE 1. BUT DELETING THE 0127 

• C(I) * NEXCOSF( DUMMY ) STATEMENT. 0128 

• OUTPUTS - SU...202) = SAME AS EXAMPLE 1. 0129 
» 0130 

• 4. INPUTS - SAME AS EXAMPLE 1. 0131 

• USAGE - SAME AS EXAMPLE 1. BUT DELETING THE 0132 
» SU) = NEXS INF ( DUMMY ) STATEMENT AND RELABELLING THE 0133 
» PREVIOUS STATEMENT AS NUMBER 10 . 0134 
» OUTPUTS - CU...202) = SAf*E AS EXAMPLE 1. 0135 
» 0136 

• 5. INPUTS - SAME AS EXAMPLE 1. EXCEPT ARGLO = 3.14159265/6.0 0137 

• USAGE - SAME AS EXAMPLE 1. 0138 

• OUTPUTS - C(l.».202) * . 866 , . 5, 0. ,-.5, . . . , 0. , . 5 0139 

• S(1...202) « .5, .866,1. ,.866, -.866 0140 
» 0141 
» 0142 
» PROGRAM FOLLOWS BELOW 0143 

• 0144 

• TRANSFER VECTOR CONTAINS COS(F), SIN(F). 0145 
» 0146 

HTR 0 XR4 0147 

BCI 1, SEQSAC 0148 

• 0149 
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* SCPSCL (SUBROUriNE) 9/29/64 LAST CARD IN DECK IS NO* 0110 

* FAP 0001 
•SCPSCL 0002 

COUNT 100 0003 

LBL SCPSCL 0004 

ENTRY SCPSCL (SPACE, NOPTP, YTOP, YBOTt CONVK, CONVLI 0005 

» 0006 

» — * — ABSTRACT 0007 

* 0008 

* TITLE - SCPSCL 0009 

* SCALE VECTOR TO INTEGERS FOR SCOPE, CLIPPING EXCESSIVf VALUES 0010 
» 0011 

* SCPSCL SCALES DATA FOR SCOPE PLOT FOR GRAPH SUBROUTINE. 0012 

* THE OUTPUT CAN BE EXPRESSED BY THE FORMULAE 0013 
» 0014 

* X = MAX1F IMIN1F { SPACE ( I ) , YTOP ) , YBOT) 0015 

* 0016 

* SPACE(I) = XFIXF (CONVK + CONVL»X) 0017 
» 0018 

* WHERE SPACE IS A FLOATING POINT VECTOR ON INPUT 0019 

* IS A FORTRAN II INTEGER VECTOR ON OUTPUT 0020 

* CONVK, CONVL, YTOP, AND YBOT ARE FLOATING POINT 0021 

* PARAMETERS SUPPLIED BY THE CALLING PROGRAM* 0022 
» 0023 

* LANGUAGE - FAP* SUBROUTINE (FORTRAN II COMPATIBLE) 0024 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0025 
» STORAGE - 33 REGISTERS 0026 

* SPEED - 0027 

* AUTHOR - S.M. SIMPSON 0028 
» 0029 

* USAGE 0030 

» 0031 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0032 

* AND FORTRAN SYSTEM ROUTINES - NONE 0033 
» 0034 

* FORTRAN USAGE 0035 

* CALL SCPSCLtSPACE, NOPTP, YTOP, YBOT, CONVK,CONVL) 0036 
» 0037 
» INPUTS 0038 

* 0039 

* SPACE(I) 1=1.. .NOPTP IS A VECTOR OF FLOATING POINT NUMBERS 0040 

* 0041 
» NOPTP IS FORTRAN II INTEGER. 0042 
» MUST BE GRTHN^i 0043 

* 0044 

* YTOP IS A FLOATING POINT NUMBER WHICH GIVES THE UPPER 0045 
» LIMIT THAT THE NUMBERS IN SPACE MAY ATTAIN BEFORE 0046 
» SCALING. IF THE NUMBER EXCEEDS YTOP THEN IT IS 0047 

* REPLACED BY YTOP. 0048 

* 0049 
» YBOT IS A FLOATING POINT NUMBER WHICH GIVES THE LOWER LIMIT 0050 

* THAT THE NUMBERS IN SPACE MAY ATTAIN BEFORE SCALING* 0051 
» IF THE NUMBER IS LSTHN YBOT THEN IT IS REPLACED BY 0052 
» YBOT* 0053 
» MUST BE LSTHN YTOP 0054 

* 0055 
« CONVK IS A FLOATING POINT NUMBER WHICH IS ADDED TO THE NUMBERS 0056 

* IN SPACE AFTER THESE ARE SCALED. 0057 
» 0058 

* CONVL IS A FLOATING POINT NUMBER BY WHICH THE NUMBERS IN SPACE 0059 

* ARE MULTIPLIED FOR SCALING. 0060 

* 0061 

* OUTPUTS 0062 

* 0063 
» SPACE(I) I=1...N0PTS IS A VECTOR OF FIXED POINT NUMBERS* 0064 

* 0065 
» EXAMPLES 0066 

* 0067 

* 1. INPUTS - SPACE(1.*.5) * -10. ,-5. , 0. , 5. , 10* NOPTP * 5 0068 

* YTOP = 20. YBOT = -20. CONVK = 2. CONVL » 10. 0069 
« OUTPUTS - SPACEU...5) = -98,-48,2,52,102 0070 

* 0071 
» 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT YTOP * 8. YBOT = ~2* 0072 

* OUTPUTS - SPACE(1...5> » -18,-18,2,52,82 0073 

* 0074 
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BCI 


1 1 SCPSCL 




0075 


SCPSCL 


SXA 


LV A 




0076 




CLA* 


2,4 


NOPTP 


0077 




PDX 


0,1 




0078 




CLA 


It* 


SPACE 


0079 




ADO 


Kl 




0080 




STA 


SC3 




0081 


*IS SPACE(I) 


GREATER OR * YTOP 


0082 


SC3 


CLA 


**, 1 


**=SPACE+1 


0083 




CAS* 


3,4 


YTOP 


0084 




NOP 




YES 


0085 




TRA 


SC5 


YES 


0086 


♦ IS IT 


LESS 


THAN OR - YBOT 




0087 




CAS* 


4,4 


YBOT 


0088 




TRA 


SCIO 


NO 


0089 




NOP 




YES 


0090 




CLA* 


4,4 


YES 


0091 




TRA 


SC 10 




0092 


SC5 


CLA* 


3,4 




0093 




TRA 


SCIO 




0094 


SCIO 


XCA 






0095 




FMP* 


6,4 


CONVL 


0096 




FAD* 


5,4 


CONVK 


0097 




UFA 


ORF 




0098 




LRS 


0 




0099 




ANA 


AN 




01 00 




LLS 


0 




0101 




ALS 


18 




0102 




STO* 


SC3 




0103 




TIX 


SC3,1,1 




0104 


LV 


AXT 


**,1 




0105 




TRA 


7,4 




0106 




r 






OiOT 


ORF 


OCT 


233000000000 




0108 


AN 


OCT 


377777 




0109 




END 






0110 
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» PRINCIPAL ENTRY, SEQSAC ( ARGLG, ARGDEL ) 



0150 



* ( TH I S 


ENTRY TAKES 78 


CYCLES PLUS 


2 COSINES PLUS 2 SINES) 


0151 


• 








0152 


SEQSAC SXO 


SEQSAC-2,4 






0153 


CLA* 


1»4 






0154 


STO 


LASBAS 


LASBAS = 


ARGLO 


0155 


FSB* 


2,4 






0156 


STO 


TEMP 






0157 


TSX 


$C0S f 4 






0158 


STO 


LASCOS 


LASCOS * 


COSCARGLO- ARGDEL) 


0159 


CLA 


TEMP 






0160 


TSX 


$SIN,4 






0161 


STO 


LASSIN 


LASSIN * 


SIN( ARGLO-ARGOEL) 


0162 


LXD 


SEQSAC-2,4 






0163 


CLA* 


2,4 






0164 


TSX 


$C0S,4 






0165 


STO 


COSDEL 


COSDEL » 


COS(ARGDEL) 


0166 


LXD 


SEQSAC-2,4 






0167 


CLA* 


2,4 






0168 


TSX 


$SIN,4 






0169 


STO 


SINDEL 


SINDEL = 


S INI ARGDEL ) 


0170 


LXD 


SEQSAC-2,4 






0171 


LDQ* 


2,4 






0172 


FMP 


FNMAX 






0173 


STO 


BASDEL 


BASOEL = 


FNMAX*ARGDEL 


0174 


STZ 


NSOFAR 






0175 


STZ 


ZFBUSD 






0176 


TRA 


3,4 






0177 


• 








0178 


* SECOND ENTRY. NEXCOS FC DUMMY) 




0179 



(AVERAGE - 9 CYCLES IF JUMP TO NEW, 6 OTHERWISE) 



NEXCOS STZ 
NZT 
STZ 
NZT 
TRA 



ZIFCOS 
ZFBUSD 
ZFLCOS 
ZFLCOS 
NEW 



* (LAST ENTRY REQUESTED SINE AND COMPUTED BOTH SINE AND COS INI ) 



CLA 
STZ 
TRA 



LASCOS 
ZFBUSD 
1,4 



* THIRD ENTRY. NEXSIN F ( DUMMY ) 



NEXSIN SXD 
NZT 
SXD 
ZET 
TRA 



ZIFC0S*4 
ZFBUSD 
ZFLCOS, 4 
ZFLCOS 
NEW 



* (LAST ENTRY REQUESTED COSINE AND COMPUTED BOTH SINE AND COSINE > 



CLA 
STZ 
TRA 



LASSIN 
ZFBUSD 
lt4 



* RECOMPUTE THE 101-ST, THE 201-ST, ... VALUES 

* (AVERAGE TIME - 30 CYCLES PLUS 1 SINE PLUS 1 COSINE) 



RESET 



CLA 
STO 
CLA 
FAD 
STO 
TSX 
STO 
CLA 
TSX 
LXD 
TRA 



KD1 

NSOFAR 

LASBAS 

BASDEL 

LASBAS 

$SIN,4 

LASSIN 

LASBAS 

$C0S,4 

ZFBUSD, 4 

STO 



» IF NEW VALUES TO BE COMPUTED, CHECK FOR RESETTING FIRST 



0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
0197 
0198 
0199 
0200 
0201 
0202 
0203 
0204 
0205 
0206 
0207 
0208 
0209 
0210 
0211 
0212 
0213 
0214 
0215 
0216 
0217 
0218 
0219 
0220 
0221 
0222 
0223 
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• 


i AVERAGE TIME - 10 CYCLES) 


0224 


• 








0225 


NEW 


SXD 


ZFBUSDI4 




0226 




CLA 


NSOFAR 




0227 




ADD 


KD1 




0228 




STO 


NSOFAR 




0229 




CAS 


NMAX 




0230 




TRA 


RESET 




0231 




NOP 






0232 


* 








0233 


* IF NO RESETTING, COMPUTE 




0234 


» 








0235 


* NEWSIN » 


LASSIN#COSDEL+LASCOS*SINDEL 


0236 


• 








0237 


♦ NEWCOS * 


LASCOS*COSDEL-LASSlN*SINDEL 


0238 


* 








0239 


* 


< AVERAGE TIME INCLUDING 


EXIT - 87 CYCLES) 


0240 


• 








0241 




LDQ 


LASSIN 




0242 




FMP 


COSDEL 




0243 




STO 


TEMP 




0244 




LDQ 


LASCOS 




0245 




FMP 


SINDEL 




0246 




FAD 


TEMP 




0247 




LDQ 


LASSIN 




0248 




STO 


LASSIN 


STORE NEWS IN 


0249 




FMP 


SINDEL 




0250 




STO 


TEMP 




0251 




LDQ 


LASCOS 




0252 




FMP 


COSDEL 




0253 




FSB 


TEMP 




0254 


STO 


STO 


LASCOS 


STORE NEWCOS 


0255 




Lt: i 










CLA 


LASSIN 




0257 




TRA 


lt4 




0258 


• 








0259 


* CONSTANTS 


, TEMPORARIES 




0260 


* 








0261 


KD1 


PZE 


0,0,1 




0262 


NMAX 


PZE 


0,0,100 




0263 


FNMAX 


DEC 


100.0 




0264 


LASBAS 


PZE 


«* f »* , ft* 


ARGLO, ARGLO+BASDEL, • 


0265 


BASDEL 


PZE 


««,»*,** 


ARGDEL*FNMAX 


0266 


NSOFAR 


PZE 


0,0, »» 


» 0,1, .*„,NMAX + l,l,2t .*<.,NMAX+l,l*2#.*. 


0267 


ZFBUSD 


PZE 


**,*«, ft* 


ZERO IF BOTH PREVIOUSLY COMPUTED SINE AND 


0268 


• 






COSINE VALUES WERE USED 10 IfillTIALI 


0269 


ZIFCOS 


PZE 


•***«, #* 


ZERO IF PRESENT REQUEST IS FOR COSINE 


0270 


ZFLCOS 


PZE 


♦ft , ft* , ft* 


ZERO IF LAST REQUEST WAS FOR COSINE 


0271 


COSDEL 


PZE 


*• t ** , ftft 


COS( ARGDEL ) 


0272 


SINDEL 


PZE 


ft* , *« y # ft 


SIN( ARGDEL) 


0273 


LASCOS 


PZE 


»», »* f ft* 


INITIAL = COS (ARGLO- ARGDEL \ 


0274 


LASSIN 


PZE 


ftftfftft,** 


INITIAL = S IN( ARGLO— ARGDEL 1 


0275 


TEMP 


PZE 
END 


♦ ft t *• f ft* 




0276 
0277 
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* SET I NO (SUBROUTINE) 9/8/64 LAST CARD IN DECK IS NO* 0091 

» LABEL 0001 

CSETINO 0002 

SUBROUTINE SETI N0< IT APE » ZIFNEW, NRECS, ERR) 0003 

C 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - SETINO 0008 

C INITIALIZE FOR ADDING TO AN INDATA-OUDATA TAPE 0009 

C 0010 

C SETINO POSITIONS A TAPE FOR RECEIVING RECORDS WRITTEN 0011 

C BY SUBROUTINE OUDATA. IF THE TAPE IS FRESH, SETINO 0012 

C MERELY REWINDS IT. IF THE TAPE CONTAINS RECORDS 0013 

C PREVIOUSLY WRITTEN BY SUBROUTINE OUDATA AND TERMINATED 0014 

C BY A RECORD WITH ZERO RECCRD NUMBER, SETINO REWINDS 0015 

C THE TAPE AND SEARCHES FOR THE TERMINATING RECORD. 0016 

C THE TAPE IS THEN LEFT POSITIONED SO THAT THE NEXT 0017 

C RECORD WRITTEN BY OUDATA WILL REPLACE THE TERMINATING 0018 

C RECORD. A RECORD COUNT IS ALSO FURNISHED. 0019 

C 0020 

C LANGUAGE - FORTRAN-II SUBROUTINE 0021 

C EQUIPMENT - 709,7090,7094 MAIN FRAME PLUS 1 TAPE DRIVE 0022 

C STORAGE - 84 REGISTERS 0023 

C SPEED - DEPENDS ON INITIAL TAPE POSITION AND SEARCH TIME* 0024 

C AUTHOR - S.M. SIMPSON, JUNE 1964 0025 

C 0026 

C 0027 

C USAGE 0028 

C 0029 

C TRANSFER VECTOR CONTAINS ROUTINES - XLIMIT, FSKIP 0030 

C AND FORTRAN SYSTEM ROUTINES - IRWT), ITSB), (RLR) 0031 

^ Ami 

C FORTRAN USAGE 0033 

C CALL SETINOMTAPE, ZIFNEW, NRECS, ERR) 0034 

C 0035 

C 0036 

C INPUTS 0037 

C 0038 

C ITAPE IS THE LOGICAL TAPE NUMBER 0039 

C MUST EXCEED ZERO AND BE LSTHN- 20 0040 

C 0041 

C ZIFNEW » 0.0 IMPLIES NOTHING ON ITAPE IS TO BE SAVED. 0042 

C NOT= 0.0 IMPLIES ITAPE CONTAINS INDATA-OUDATA FORMAT 0043 

C RECORDS, ALL OF WHICH ARE TO BE SAVED. 0044 

C 0045 

C 0046 

C OUTPUTS THE TAPE IS POSITIONED AS DESCRIBED IN ABSTRACT. 0047 

C 0048 

C NRECS =0 IF ZIFNEW - 0. OTHERWISE, 0049 

C » NUMBER OF RECORDS PASSED OVER IN SEARCH FOR 0050 

C TERMINATING RECORD, NOT COUNTING THE TERMINATING 0051 

C RECORD. 0052 

C 0053 

C ERR = 0.0 IF ALL OK 0054 

C » 1.0 IF ITAPE IS ILLEGAL, IN WHICH CASE NO TAPE 0055 

C MOVEMENT IS ATTEMPTED AND NRECS IS NOT DISTURBED. 0056 

C 0057 

C 0058 

C EXAMPLES 0059 

C 0060 

C 1. INPUTS - ASSUME A 6 RECORD INDATA-OUDATA TAPE HAS BEEN CREATED 0061 

C ON LOGICAL 9 BY THE FOLLOWING SEQUENCE. 0062 

C REWIND 9 0063 

C DO 10 1=1,10 0064 

C 10 X(I) « FLOATF ( I ) 0065 

C CO 20 1=1,5 0066 

C IRECNO = I 0067 

C 20 CALL GUDATA<9, IRECNO, 10, X,l) 0068 

C IRECNO » 0 0069 

C CALL 0UDATA(9, IRECNO, I, DUMMY, 1) 0070 

C 0071 

C USAGE - CALL SETINO (9, 1 .0, NRECS, ERR ) 0072 

C 0073 

C OUTPUTS - NRECS=5, ERR=0.0, AND TAPE IS POSITIONED TO REWRITE 0074 
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C THE 6-TH RECORD. 

C 

C PROGRAM FOLLOWS BELOW 
C 

ERR = XABSFtXLIMITFI ITAPE,1,20>) 

IF (ERR) 9999,10,9999 
10 NRECS - 0 

REWIND I TAPE 

IF (ZIFNEW) 20,9999,20 
20 READ TAPE ITAPE# IRECNO 

CALL FSKIPUTAPE, 1) 

IF (IRECNO) 30,60,30 
30 NRECS = NRECS+l 

GO TO 20 
60 CALL FSKIPUTAPE, -1) 
9999 RETURN 

END 
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0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
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» SETK (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0189 

* FAP 0001 
•SETK 0002 

COUNT 200 0003 

LBL SETK 0004 

ENTRY SETK ( C, XI , X2, . . . , XN ) 0005 

ENTRY SETKS ( C1,X1 ,C2, X2, . . . ,CN , XN ) 0006 

ENTRY SETVEC ( X, Ci,C2,. . . ,CN) 0007 

* 0008 
» ABSTRACT 0009 

* 0010 

* TITLE - SETK WITH SECONDARY ENTRIES SETKS AND SETVEC 0011 
» SET VARIABLES OR VECTORS TO GIVEN VALUES 0012 

* 0013 

* SETK IS A VAR I ABLE-LENGTH-CALL I NG— SEQUENCE SUBROUTINE 0014 

* WHICH SETS EACH OF ITS ARGUMENTS BEYOND THE FIRST EQUAL 0015 

* TO THE FIRST ARGUMENT, THE MODE OF WHICH IS ARBITRARY* 0016 

* 0017 

* SETKS IS A VARIABLE-LENGTH-CALLING-SEQUENCE SUBROUTINE, 0018 
» REQUIRING AN EVEN NO. OF ARGUMENTS WHICH ARE TREATED IN 0019 

* PAIRS. THE SECOND ARGUMENT OF EACH PAIR IS SET EQUAL 0020 

* TO THE FIRST ARGUMENT OF THE PAIR, THE MODE OF WHICH IS 0021 

* ARBITRARY. 0022 

* 0023 

* SETVEC IS A VARIABLE-LENGTH-CALL ING—SEQUENCE SUBROUTINE 0024 

* WHOSE FIRST ARGUMENT IS CONSIDERED A VECTOR OF LENGTH 0025 

* EQUAL TC THE NO. OF ADDITIONAL ARGUMENTS PRESENT* THE 0026 

* ELEMENTS OF THIS VECTOR ARE SET SEQUENTIALLY EQUAL TO 0027 

* THE REMAINING ARGUMENTS* WHOSE MODES ARE ARBITRARY. 0028 

* 0029 

* THE NUMBER OF ARGUMENTS WHICH MAY BE USED IS NOT 0030 
« RESTRICTED. 0031 

- Ana *> 

» LANGUAGE - FAP SUBROUTINES, FORTRAN— 1 1 COMPATIBLE 0033 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0034 

* STORAGE - 37 REGISTERS 0035 
» SPEED - SETK TAKES 14 ♦ 13»N1 MACHINE CYCLES, 0036 

* WHERE Nl+1 IS THE ARGUMENT COUNT. 0037 

* SETKS TAKES 11 + 16»N2 MACHINE CYCLES, 0038 

* WHERE 2«N2 IS THE ARGUMENT COUNT. 0039 

* SETVEC TAKES 13 ♦ 21*N3 MACHINE CYCLES, 0040 

* WHERE N3+1 IS THE ARGUMENT COUNT. 0041 
» AUTHOR - S.M. SIMPSON JR., SEPTEMBER 1963 0042 

* 0043 

* ^ USAGE 0044 

* 0045 

* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0046 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0047 

* 0048 

* FORTRAN USAGE OF SETK 0049 

* CALL SETK ( C , XI * X2 ,X3, . . . , XN) 0050 
» WHERE N SHOULD EXCEED ZERO, AND THE MODES OF THE 0051 

* ARGUMENT NAMES ARE ARBITRARY. 0052 

* 0053 

* INPUTS 0054 
» 0055 
« C IS A QUANTITY IN ANY MODE 0056 

* 0057 

* OUTPUTS PROGRAM RETURNS CONTROL WITH NO OUTPUT IF THE ARGUMENT 0058 

* COUNT IS 1 (N=0). 0059 

* 0060 

* XI IS SET = C 0061 

* X2 IS SET = C 0062 

* ETC 0063 
» XN IS SET « C 0064 

* 0065 

* 0066 

* FORTRAN USAGE OF SETKS 0067 

* CALL SETKS ( CI , X 1 , C2 , X2 , C3, X3, . . . , CN, XN ) 0068 

* WHERE N SHOULD EXCEED ZERO, AND WHERE THE MODES OF 0069 
« THE ARGUMENT NAMES ARE ARBITRARY. 0070 

* 0071 
» INPUTS 0072 

* 0073 

* CI IS A QUANTITY IN ANY MODE 0074 
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* C2 IS A QUANTITY IN ANY MODE 0075 
» ETC 0076 
» CN IS A QUANTITY IN ANY MODE 0077 
» 0078 

* OUTPUTS AN IMPROPER RETURN RESULTS IF THE ARGUMENT COUNT IS ZERO 0079 
» OR NOT EVEN. 0080 

* 0081 

* XI IS SET = CI 0082 

* X2 IS SET = C2 0083 

* ETC 0084 

* XN IS SET * CN 0085 

* 0086 

* EQUIVALENCE (CM, XL) IS PERMITTED, BEHAVIOUR DEPENDS ON 0087 
» THE FACT THAT THE SETTING SEQUENCE IS X1,X2,..*,XN. 0088 

* 0089 
» 0090 

* FORTRAN USAGE OF SETVEC 0091 

* CALL SETVEC1X,C1,C2,C3,...,CN) 0092 
« WHERE N SHOULD EXCEEO ZERO* AND WHERE THE MODES OF 0093 
» THE ARGUMENT NAMES ARE ARBITRARY 0094 
» 0095 

* INPUTS 0096 
» 0097 
» CI IS VALUE FOR SETTING X(l) 0098 

* ETC 0099 

* CN IS VALUE FOR SETTING X(N) 0100 
» 0101 

* OUTPUTS PROGRAM RETURNS CONTROL WITH NO OUTPUTS IF THE ARGUMENT 0102 

* COUNT IS 1. 0103 
» 0104 
» X{li2f,.. t N) IS SET = C1,C2,...,CN 0105 
» 0106 

* EQUIVALENCE i ANY TWO ARGUMENTS) IS PERMITTED, BEHAVIOUR 0107 
» DEPENDING ON THE FACT THAT THE SETTING SEQUENCE IS 0108 

* xm,x(2),...,x(N) 0109 

» 0110 

* 0111 

* EXAMPLES 0112 
» 0113 
» 1. EXAMPLES OF SETK 0114 
» USAGE - CALL SETK i 4.0, A, B, C, D, E, F, G, H ) 0115 
« CALL SETK(3,I, J,K,L,M) 0116 

* CALL SETK(M,N) 0117 

* OUTPUTS - A=B=C=B=E=F=G=H = 4.0 0118 

* I=j=k=L=M = 3 0119 
» N =3 0120 
» 0121 

* 2. EXAMPLES OF SETKS 0122 

* USAGE - CALL SETKS( 2. ,A, 3, I ,4. ,8,5, J*6,K ) 0123 

* CALL SETKSC 3. 1416, X , 1963, L , X, Y, X, Z, L,M ) 0124 

* CALL SETKSC 5.,C) 0125 

* OUTPUTS - A=2.0, 1=3, B*4.0, J=5, K=6 0126 

* X=Y=Z » 3.1416, L=M = 1963 0127 

* C * 5. 0128 
» 0129 

* 3. EXAMPLES OF SETVEC 0130 
» USAGE - CALL SETVEC ( X ,9. , 7. , 8 . , 14. ) 0131 

* CALL SETVEC ( I, 19630, 2, I, I , I( 2) , 5) 0132 
» CALL SETVEC ( J, 5) 0133 
» OUTPUTS - X11...4) = 9*, 7*, 8., 14. 0134 

* 1(1. ..6) = 19630, 2, 19630, 19630, 2» 5 0135 

* J » 5 0136 
« 0137 

* PROGRAM FOLLOWS BELOW 0138 

* 0139 
» 0140 

* NO TRANSFER VECTOR 0141 

HTR 0 ORIGINAL XR4 0142 

BCI 1,SETK 0143 

* PRINCIPAL ENTRY. SETM C , XI , X2 , . , XN ) 0144 
SETK LDQ* 1,4 C IN MQ (STAYS THERE) 0145 

CLA TRAK 0146 

SXD4 SXD SETK-2,4 0147 
TXI SETUP, 4,-1 (SET TO START WITH XI) 0148 

* SECOND ENTRY. SETKS ( CI, XI ,C2 ,X2 , . . . ,CN, XN ) 0149 
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SETKS SXD 
CLA 
TRA 

* THIRD ENTRY, 
SETVEC CLA 

STA 
CLA 
TRA 

* MERGE POINT 
SETUP STA 



SETK-2,4 

TRAKS 

SETUP 

SETVEC(X,C1,C2,.*.,CN) 



» LOOP. 
CAL 



TRA 
» EXIT 

LEAVE 
* SETK 

MOREK 



CHECK 
CAL 
ANA 
LAS 
TRA 
TRA 

AT ENO 
TRA 

INSERT 
STQ* 
TXI 

* SETKS INSERT 
MOREKS CLA* 

STO* 
TXI 

• SETVEC INSERT 
MORESV CLA* 

STO STO 
CLA 
SUB 
STO 
TXI 



1,4 

STO 

TRASV 

SXD4 

TRA 
IF 1 
1.4 

MASK 
TSXZ 
LEAVE 



A(X) 



(ADJUST XR4 TO START WITH CI) 



4 ISA TSX 



X,0 



KNOCK OUT ADDRESS 



** **=MOREK 
OF ARGUMENT STRING 
1,4 



OR MOREKS OR MORESV 



1,4 

CAL, 4,-1 



C TO 
BACK 



XJ 

FOR NEXT 



1,4 
2,4 

CAL, 

1,4 
** 

STO 
Kl 
STO 
CAL, 



4,-2 



4,-1 



CJ 

TO XJ 

BACK FOR NEXT PAIR 



**=A(X) 



CJ 

TO X(JI 
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0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0173 
0179 
0180 
0181 



TRAK 


TRA 


MOREK 


0183 


TRAKS 


TRA 


MOREKS 


0184 


TRASV 


TRA 


MORESV 


0185 


MASK 


OCT 


777777700000 


0186 


TSXZ 


TSX 


0,0 


0187 


Ki 


PZE 


1 


0188 




END 




0189 
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» SETK -II (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO- 

• LABEL 
CSETK -II 

SUBROUTINE SETK(C) 

C 

C * ABSTRACT 

C 

C TITLE - SETK -II 

C SET ANY NO. OF VARIABLES EQUAL TO A SINGLE VALUE (FXD OR FLTGI 

C 

SETK IS A VARIABLE-LENGTH-CALLING-SEQUENCE SUBROUTINE 
WHICH SETS EACH OF ITS ARGUMENTS BEYOND THE FIRST EQUAL 
TO THE FIRST ARGUMENT, THE MODE OF WHICH IS ARBITRARY. 



C 
C 

c 
c 
c 
c 
c 

C LANGUAGE 
C EQUIPMENT 
C STORAGE 
C SPEED 
C 

C AUTHOR 
C 
C 
C 

C TRANSFER VECTOR CONTAINS ROUTINES - SETUP, STORE, RETURN 

C AND FORTRAN SYSTEM ROUTINES - < NONE) 

C 

C FORTRAN USAGE 

C CALL SETK t C ,X 1 #X2 ,X3, . . . , XN > 



THIS VERSION OF SETK (SETK-II) IS THE FORTRAN IQUI VALENT 
OF THE FAP SUBROUTINE OF THE SAME NAME. 

FORTRAN II SUBROUTINE 
709 OR 7090 {MAIN FRAME ONLY) 
63 REGISTERS 

ABOUT 700+165*N MACHINE CYCLES, WHERE N+l * TOTAL 
ARGUMENT COUNT. 
S.M. SIMPSON, AUGUST 1963 

USAGE 



WHERE N SHOULD EXCEED ZERO, AND THE MODES OF THE 
ARGUMENT NAMES ARE ARBITRARY. 



IS A QUANTITY IN ANY MODE 



PROGRAM RETURNS CONTROL WITH NO OUTPUT IF THE ARGUMENT 
COUNT IS LESS THAN 2. 



XI 

X2 



ETC 



XN 



IS SET = C 
IS SET = C 



IS SET * C 



C 
C 
C 

C INPUTS 
C 

C C 
C 

C OUTPUTS 
C 
C 
C 
C 
C 
C 

c 
c 
c 
c 

C EXAMPLES 
C 

C I. USAGE 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 

C PROGRAM FOLLOWS BELOW 
C 

C ACQUIRE ARGUMENT COUNT AND EXIT IF LESS THAN 2 
CALL SETUP<L0CALL,NARGS,XR1,XR2) 
IF (NARGS-1) 9999,9999,10 
C SET XI. ..XN 
10 DO 20 NUMARG-2 , NARGS 
20 CALL STORE (C, LOG ALL, NUMARG, 1) 
C EXIT 

9999 CALL RETURN iLOC ALL »XR1,XR2 ) 
END 



OUTPUTS 



EQUIVALENCE i ANY TWO ARGUMENTS) IS PERMITTED BUT SERVES 
NO PARTICULAR FUNCTION. 



CALL SETM4.0, A, B, C, D, E, F, G, H) 

CALL SETM3,I,J,K,L,M) 

CALL SETK< M, N ) 

CALL SETK( 1. ) 

CALL SETK 

A=B=C=D=E=F=G=H = 4.0 
I=J=K=L=M = 3 

N =3 

AND NO OUTPUT RESULTS FROM LAST TWO CALLS 



0072 
000! 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
002 3 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
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♦SETKP 



SETKP 
FAP 

COUNT 
LBt 
ENTRY 

ENTRY 



(SUBROUTINE) 



9/29/64 LAST CARD IN DECK IS NO, 



100 
SETKP 

SETKP (C1,X11,X12,...,X1N1, STOP f C2,X2i,X22, . J. <X2N2* 

STOP, , CM,XM1,XM2, ...,XMNM) 

SETVCP (X1,C11,C12,...,C1N1,ST0P, X2,C21,C22, .*i,C2N2» 

* STOP, , XM,CM1,XM2,...,CMNM) 

• 

* ABSTRACT 

• 

* TITLE - SETKP WITH SECONDARY ENTRY SETVCP 

* PLURALI ZED FORMS OF SUBROUTINES SETK AND SETVEC 
• 

* SETKP IS THE PLURAL FORM OF SUBROUTINE SETK, SETKP HAS 

* A VARIABLE NUMBER OF ARGUMENTS SEPARATED INTO AN 

* ARBITRARY NUMBER OF GROUPS BY A FENCE-TYPE ARGUMENT* 

* EACH SUCH GROUP REPRESENTS THE ARGUMENTS OF ONE CALL SETK 
» STATEMENT. SUBROUTINE SETK IS CALLED SUCCESSIVELY, ONCE 

* FOR EACH GROUP. 
• 

» SETVCP PERFORMS THE ANALOGOUS FUNCTION FOR SUBROUTINE 

« SETVEC. 



* LANGUAGE 

• EQUIPMENT 

* STORAGE 
» SPEED 

• AUTHOR 



FAP SUBROUTINES I FORTRAN—I I COMPATIBLE) 
709 OR 7090 (MAIN FRAME ONLY) 
40 REGISTERS 

S.M. SIMPSON JR., SEPTEMBER 1963 
USAGE 



►*C2N2,ST0P, 



• TRANSFER VECTOR CONTAINS ROUTINES - SETK, SETVEC 

• AND FORTRAN SYSTEM ROUTINES - (NONE) 
• 

» FORTRAN USAGE OF SETKP 
• 

» CALL SETKP ( C 1 , X 1 1 , X12 , . . . , X INI, STOP, C2,X 12, X22, .i. . , X2N2,fST0P, 

• 1 ,CM,XM1,XM2,...,XMNM) 

• 

• WHERE STOP « OCT 777777712345, IS EQUIVALENT TO 

• CALL SETK<C1,X11,X12,...,X1NI) 

• CALL SETK<C2,X21,X22,...,X2N2> 
» ETC 

• CALL SETK(CM,XMl,XM2,*..,XMNM) 
» 

« FORTRAN USAGE OF SETVCP 
• 

» CALL SETVCP(X1,C11,C12,..*,CIN1,ST0P,X2,C21,C22,, 

» 1 .*....,XM,CM1,CM2,...,CMNM) 

• IS EQUIVALENT TO 

• CALL SETVEC(X1,C11,C12,...,C1N1) 
» CALL SETVECIX2,C21,C22,...,C2N2) 

• ETC 

• CALL SETVECtXM,€Ml,CM2,...,CMNM) 
• 

« SEE WRITEUPS OF SETK AND SETVEC FOR INPUT-OUTPUT DETAILS. 
« 

• EXAMPLES 
• 

• 1. USAGE - B STOP = 777777712345 

• CALL SETKP(i.,X,Y,2,ST0P,2.,U,V,W,ST0P,7^IX) 
» CALL SETVCP(A,1.,2,,3.,ST0P,B,7.) 

» OUTPUTS - X=Y=Z * 1. U=V=W =2. IX = 7 
» A(l.».3) = 1., 2., 3. B(l) = 7. 

• 

» PROGRAM FOLLOWS BELOW 
• 

• TRANSFER VECTOR CONTAINS SETK, SETVEC 

HTR 0 XR1 

HTR 0 XR4 

BCI 1, SETKP 



0123 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 

0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
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• PRINCIPAL ENTRY. SETKPtCl 


,X11,X12,...,X1N,ST0P, 


0073 


* 


C2 


,X21,X22, ...,X2N,ST0P,* 


0074 


• 


CM 


,XM1,XM2, ...,XMN) 


0075 


SETKP CLA 


TSXSK 




0076 


TRA 


SETUP 




0077 


• SECOND ENTRY. SETVCP ( XI ,C I 1 ,C 12, . . . ,C1N, STOP, 


0078 


• 


X2,C21,C22,...,C2N, STOP ....... 


0079 


• 


XM,CM1,CM2,...,CMN) 


0080 


SETVCP CLA 


TSXSV 




0081 


SETUP STA 


TRASUB 




0082 


SXO 


SETKP-2,4 




0083 


SXD 


SETKP-3,1 




0084 


» USE XR1 TO 


SCAN FOR STOP OR END OF SEQUENCE, 


0085 


• HOLDING XR4 


FOR FOOLING SETK OR SETVEC. 


0086 


NEXT PXA 


0,4 




0087 


PAX 


0,1 




0088 


CAL CAL 


1,1 


TSX ARG, 0 OR SOMETHING ELSE 


0089 


ANA 


AMASK 




0090 


LAS 


TSXZ 




0091 


TRA 


NOARG 


NO 


0092 


TRA 


ISARG 


YES 


0093 


* IF NOT AN ARGUMENT, ENTER 


SUBROUTINE WITHOUT REPLACING 1,1 


0094 


NOARG TRA 


GOOUT 




0095 


» IT IT IS AN 


ARGUMENT, CHECK FOR STOP 


0096 


ISARG CAL* 


1,1 




0097 


LAS 


STOP 




0098 


TRA 


»+2 


NO 


0099 


TRA 


ISTOP 


YES 


0100 


TXI 


CAL, 1,-1 


MORE ARGUMENTS 


0101 


» IF STOP IS 


FOUND, REPLACE 


IT AND GO OPERATE 


0102 


I STOP CLA 


TRABAK 




0103 


STO 


1,1 




0104 


» GO OPERATE 


SETK OR SETVEC. 


(RETURNS ONLY IF 1,1 WAS A STOPI 


0105 


GOOUT SXA 


BACK,1 




0106 


LXD 


SETKP-3,1 




0107 


TRASUB TRA 


»* 


»» = A( TTR SETK) OR AITTR SETVEC* 


0108 


♦ IF IT COMES 


BACK, RESTORE 


XR4 TO OLD XR1, RESTORE STOP, 


0109 


» INDEX XR4, 


AND RETURN FOR 


NEXT CALL. 


0110 


BACK AXT 


♦ ♦,4 


** = XR1 BEFORE SUBROUTINE 


0111 


CLA 


TSXSTP 




0112 


STO 


1,4 




0113 


TXI 


NEXT, 4,-1 




0114 


» CONSTANTS 






0115 


TSXSK TSX 


$SETK,4 




0116 


TSXSV TSX 


$SETVEC,4 




0117 


TRABAK TRA 


BACK 




0118 


TSXSTP TSX 


STOP,0 




0119 


STOP CCT 


777777712345 




0120 


TSXZ TSX 


0,0 




0121 


AMASK OCT 


777777700000 




0122 


END 






0123 



***»•••»*•**•***»«•«•*»* PROGRAM LISTINGS 

» SETKS ♦ 

•**#*•*»•»•*#••*•**•**•» 

REFER TO 
SETK 



«**»*»«*«• »«•••»*•» 

« SETKS * 
#••*••*•*•»*«»««*»****«* 

REFER TO 
SETK 



•••••••«»*»«»****•*•«••* PROGRAM LISTINGS *•##****»***•••*•«*•#»#* 

» SETKS -II * * SETKS -II • 

•*•***•*••••*•********•• ** **••*«* ***»«••** 

♦ SETKS -II (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO* 0085 

• LABEL 0001 
CSETKS -II 0002 

SUBROUTINE SETKS 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - SETKS -II 0007 
C SET ANY NO* OF VARIABLES EQUAL TO SEPARATE VALUES (FXD OR FLTGI 0008 

C 0009 

C SETKS IS A VARIABLE-LENGTH-CALLING-SEQUENCE SUBROUTINE, 0010 

C REQUIRING AN EVEN NO* OF ARGUMENTS WHICH ARE TREATED IN 0011 

C PAIRS. THE SECOND ARGUMENT OF EACH PAIR IS SET EQUAL 0012 
C TO THE FIRST ARGUMENT OF THE PAIR, THE MODE OF WHICH IS 0013 

C ARBITRARY. 0014 

C 0015 

C THIS VERSION OF SETKS (SETKS-II) IS THE FORTRAN 0016 

C EQUIVALENT OF THE FAP SUBROUTINE CF THE SAME NAME. 0017 

C 0018 

C LANGUAGE - FORTRAN II SUBROUTINE 0019 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0020 

C STORAGE - 91 REGISTERS 0021 

C SPEED - ABOUT 750+250*N MACHINE CYCLES, WHERE 2*N * TOTAL 0022 

C ARGUMENT COUNT. 0023 

C AUTHOR - S.M. SIMPSON, AUGUST 1963 0024 

C 0025 

C USAGE 0026 

C 0027 

C TRANSFER VECTOR CONTAINS ROUTINES - SETUP, ARG, STORE, RETURN 0028 

C AND FORTRAN SYSTEM ROUTINES - (NONE) 0029 

C 0030 

C FORTRAN USAGE 0031 

C CALL SETKS ( CI , XI , C2 , X2 , C3 , X3, . . . ,CN, XN ) 0032 

C WHERE N SHOULD EXCEED ZERO, AND WHERE THE MODES OF 0033 

C THE ARGUMENT NAMES ARE ARBITRARY* 0034 

C 0035 

C INPUTS 0036 

C 0037 

C CI IS A QUANTITY IN ANY MODE 0038 

C C2 IS A QUANTITY IN ANY MODE 0039 

C ETC 0040 

C CN IS A QUANTITY IN ANY MODE 0041 

C 0042 

C OUTPUTS PROGRAM RETURNS CONTROL WITH NO OUTPUT IF THE ARGUMENT 0043 

C COUNT IS ZERO OR IS NOT EVEN. 0044 

C 0045 

C XI IS SET » Ci 0046 

C X2 IS SET = C2 0047 

C ETC 0048 

C XN IS SET - CN 0049 

C 0050 

C EQUIVALENCE (CM, XL) IS PERMITTED. BEHAVIOUR DEPENDS ON 0051 

C FACT THAT SETTING SEQUENCE IS X 1, X2, * , XN. 0052 

C 0053 

C EXAMPLES 0054 

C 0055 

C 1. USAGE - CALL SETKS( 2. , A, 3, I , 4* , B, 5, J , 6,K ) 0056 

C CALL SETKS( 3. 1416, X, 1963,L,X,Y.X t Z, t,M) 0057 

C CALL SETKS( 5*,C) 0058 

C D=0. 0059 

C CALL SETKS( 6. ,0,7.) 0060 

C CALL S£TKS( 8.) 0061 

C CALL SETKS 0062 

C OUTPUTS - A=2*0, 1*3, B-=4.0, J=5, K=6 0063 

C X=Y=Z * 3.1416, L=M = 1963 0064 

C C * 5. 0065 

C D * 0. (NO OUTPUTS SINCE ODD NO. ARGUMENTS) 0066 

C LIKEWISE LAST TWO CALLS PRODUCE NO OUTPUT 0067 

C x 0068 

C PROGRAM FOLLOWS BELCW 0069 

C 0070 

C 0071 

C ACQUIRt ARGUMENT COUNT AND CHECK IT 0072 

CALL SETUP(LCCALL,NARGS,XRl,XR2) 0073 

NPAIRS=NARGS/2 0074 



»»#»»*###***♦*#*»****#*♦ PROGRAM LISTINGS 

* SETKS -II * 

••******•*»*»*»*•»•»***# 

( PAGE 2) 

IF (NPAIRS) 9999,9999,10 
10 IF (2*NPAIRS-NARGS) 9999,20,9999 
C SET X1,X2,„..,XN 
20 00 30 IXPAIR=1, NPAIRS 
NUMARG=2*IXPAIR-i 
C-ARGF (L0CALL,NUMARG,1) 
NUMARG-NUMARG+ I 
30 CALL STORE (C,L0C ALL, NUMARG, 1) 
C EXIT 

9999 CALL RETURN < LOC ALL , XR1 , XR2 ) 

END 



«**»*«•»«•**•«*«•••***** 

# SETKS -II « 
^**#»* #*#**» *«•**• **••»» 

< PAGE 2) 

0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 



* SETKV * 
*••#••••«••*****-•*•*#•*• 



PROGRAM LISTINGS 



*»•#*»»•*# 4* *«•*****••*» 
» SETKV » 
#**#*##*»###*»•»*#****»# 



SETKV (SUBROUTINE) 
FAP 



9/29/64 LAST CARD IN DECK IS NO. 



•SETKV 



COUNT 

LBL 

ENTRY 



100 

SETKV 

SETKV 



(C,LX,X) 
— — ABSTRACT — — 



« TITLE - SETKV 

* SET ALL ELEMENTS OF VECTOR EQUAL TO A CONSTANT (ANY MODE) 



* LANGUAGE 
« EQUIPMENT 
» STORAGE 

♦ SPEED 
« AUTHOR 



SETKV SETS XI 1...LX) = C WHERE C IS ANY MODE. 

- FAP SUBROUTINE ( FORTRAN-I I COMPATIBLE) 

- 709 OR 7090 (MAIN FRAME ONLY) 

- 15 REGISTERS 

- 24 ♦ 4*LX MACHINE CYCLES, WHERE LX = LENGTH OF VECTOR 

- S.M. SIMPSON, AUGUST 1963 

USAGE 



» TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 
« AND FORTRAN SYSTEM ROUTINES - (NONE) 

• 

• FORTRAN USAGE 

» CALL SETKV(CLXrfX) 



» INPUTS 

* C 

* LX 
* 

* OUTPUTS 
» 

* XU) 

* EXAMPLES 
» 

* 1. USAGE 
» 

» 

* OUTPUTS 



IS A QUANTITY IN ANY MODE 

IS LENGTH OF VECTOR, GRTHN= 1 . 

STRAIGHT RETURN WITH NO OUTPUTS IF LX LSTHN 1. 

1=1. . . LX EQUALS C (UNCHANGED MODE) 
EQUIVALENCE ( C, SOME X( I) ) PERMITTED. 



CALL SETKV (3.0, 10, X) 
CALL SETKV (3,5, IX) 
CALL SETKV ( 3.0, 1,Y) 
1Y=0 

CALL SETKV (3,0, IY5 
X ( I. . . 10) =3.0 IX(1...5)=3 Y=3.0 
IY*0 (NO OUTPUT FROM LAST CALL) 



2. INPUTS - 


• X(i...7)=l., 2., 


. . . , 7 • 


USAGE 


CALL SETKV 


(X(3),7, 


OUTPUTS 


X( 1...7)=3.0 




PROGRAM FOLLOWS BELOW 




NO TRANSFER 


VECTOR 




HTR 


0 


XR4 


SCI 


1, SETKV 




ONLY ENTRY. 


SETKV(C,LX,X) 




SETKV SXD 


SETKV-2,4 




Kl LDQ* 


1,4 C 


TO MQ 


CLA 


3,4 




ADD 


Kl 


A(X)+1 


STA 


STORE 




CLA* 


2,4 


LX 


TMI 


LEAVE 




PDX 


0,4 




TXL 


LEAVE, 4,0 




STORE LOOP 






STORE STQ 


**,4 »* 


=A(xm 


TIX 


STORE, 4,1 




EXIT 






LEAVE LXD 


SETKV-2,4 




TRA 


4,4 




END 







0074 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 



• •»•«•••*****»*»»•••«**» PROGRAM LISTINGS 

» SETKVS » * SETKVS * 

•»•»*••••****•***«*»•*»» ##•****•****«*«•*«•*••*• 



« SETKVS (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0105 

« FAP 0001 

♦SETKVS 0002 

COUNT 100 0003 

LBL SETKVS 0004 

ENTRY SETKVS (C 1 , LI , X 1, C2, L2, X2, .* . ,CN , LN , XN ) 0005 

* 0006 
» ABSTRACT 0007 

* 0008 

* TITLE - SETKVS 0009 

* SET ANY NO. OF VECTORS EQUAL TO SEPARATE VALUES «FXD OR FLTG) 0010 

* 0011 

* SETKVS IS A VAR I ABLE-LENGTH-CALL I NG- SEQUENCE SUBROUTINE 0012 
» WHOSE ARGUMENTS ARE TREATED IN TRIPLETS, THE THIRD 0013 
» ARGUMENT OF EACH TRIPLET IS CONSIDERED A VECTOR OF 0014 

* LENGTH GIVEN BY THE SECOND ARGUMENT* ALL ELEMENTS IN 0015 

* THIS VECTOR ARE SET EQUAL TO THE FIRST ARGUMENT OF THE 0016 
» TRIPLET WHOSE MODE IS ARBITRARY. 0017 

* 0018 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN-I I COMPATIBLE) 0019 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0020 

* STORAGE - 25 REGISTERS 0021 

* SPEED - 9 + 28*N + 4»L MACHINE CYCLES, WHERE N * NO. OF 0022 
» VECTORS TO BE SET, AND L = THEIR TOTAL COMBINED LENGTH 0023 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 0024 

* 0025 

» USAGE 0026 

» 0027 

* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0028 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0029 

* 0030 

* FORTRAN USAGE 0031 
» Call St \ »v vo t C i , l l , ai , l2 , a2, • • • ,Cin, ljn , ain j 0032 
» WHERE N SHOULD EXCEED ZERO, AND WHERE THE MOOES 0033 
» OF THE ARGUMENT NAMES C1...CN AND XI. ..XN ARE 0034 

* ARBITRARY. 0035 

* 0036 

* INPUTS 0037 

* 0038 

* CI IS THE VALUE TO WHICH XK1...L1) ARE TO BE SET* 0039 
» 0040 

* LI SHOULD EXCEED ZERO 0041 
» ETC 0042 

* CN IS THE VALUE TO WHICH XNU...LN) ARE TO BE SET 0043 
» 0044 

* LN SHOULD EXCEED ZERO 0045 
» 0046 

* OUTPUTS AN IMPROPER RETURN RESULTS IF THE ARGUMENT COUNT IS NOT 0047 

* A MULTIPLE OF 3. 0048 
» 0049 

* XK1...L1) ARE ALL SET = CI IF LI EXCEEDS ZERO 0050 

* ETC 0051 

* XNI1...LN) ARE ALL SET * CN IF LN EXCEEDS ZERO 0052 

* 0053 

* IF ANY L VALUE IS ZERO OR NEGATIVE THE CORRESPONDING 0054 
» X VECTOR IS NOT DISTURBED 0055 

* 0056 

* EQUIVALENCE I ANY TWO ARGUMENTS) IS PERMITTED WITH 0057 

* BEHAVIOUR DEPENDING ON THE FACT THAT THE SETTING SEQUENCE 0058 
» IS X1,X2,...,XN. 0059 
» 0060 

* EXAMPLES 0061 

* 0062 
« 1. USAGE - CALL SETKVSl 2., 10, A, 4,3,1, 7. ,1,8) 0063 

* K=0 0064 

* CALL SETKVS( 9.,15,C, 5,0, K, 6,-1, K, ll.#l,D) 0065 

* OUTPUTS - AU...10) = 2., 1(1. ..3) = 4, B(1...4) = 7. 0066 

* CU...15) * 9., K = 0 (ILLEGAL LX VALUES), D = 11.0 0067 
» 0068 

* PROGRAM FOLLOWS BELOW 0069 

* 0070 

* 0071 
» NO TRANSFER VECTOR 0072 

HTR 0 XR1 0073 

HTR 0 ORIGINAL XR4 0074 



•*••••««*••«*«•*«••***•• PROGRAM 
* SETKVS * 
»»♦»»»•»♦##»*#♦****»***♦ 
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L I STINGS 

* SETKVS » 
«»•**•«••*•**«*»»••••*•» 

(PAGE 2) 



BCI 1 v SETKVS 0075 

* ONLY ENTRY. SETKVS (CI , L 1 ,X1 ,C2, L2, X2, ... ,CN, LN, XN ) 0076 
SETKVS SXD SETKVS-2,4 0077 

SXO SETKVS~3,i 0078 

» CHECK THAT 1,4 IS A TSX X,0 0079 

CAL CAL 1,4 CJ 0080 

ANA MASK 0081 

LAS TSXZ 0082 

TRA LEAVE 0083 

TRA MORE 0084 

* IF NOT, EXIT 0085 
LEAVE LXD SETKVS-3,1 0086 

TRA 1,4 0087 

* IF SO, ENTER STORE LGOP PROVIOED LENGTH IS LEGAL 008e 
MORE CLA* 2,4 LJ 0089 

TMI BACK 0090 

POX 0,1 0091 

TXL BACK,1,0 0092 

CLA 3,4 0093 

ADD Kl A(X)+1 0094 

STA STORE 0095 

Kl CLA* 1,4 CJ 0096 

* STORE LOOP 0097 
STORE STO »«,1 *»=A(Xm 0098 

TIX STORE, 1,1 0099 

* BACK FOR NEXT TRIPLET 0100 
BACK TXI CAL, 4, -3 0101 

» CONSTANTS 0102 

MASK OCT 777777700000 0103 

TSXZ TSX 0,0 0104 

END 0105 



••*•*•***»**•*••••*•••«• PROGRAM LISTINGS #«*#.#•»♦*#•*•#•#»»»#**# 

* SETLIN * * SETLIN 

••**••*****•*•*•*••***«* *•«**•*»*•*»**»»••»*«*• 



• 


SETLIN (SUBROUTINE) 9/29/64 LAST CARD 


IN DECK IS 


NO. 0094 


• 


FAP 






0001 


• SETLIN 






0002 




COUNT 


100 




0003 




LBL 


SETLIN 




0004 




ENTRY 


SETLIN { BASE, DELTA, LX, X) 




0005 




ENTRY 


XSTLIN (IBASE, IDELTA, LIX, IX) 




0006 


* 








0007 


» 




~ ABSTRACT 




0008 


• 








0009 


* 


TITLE - SETLIN WITH SECONDARY ENTRY XSTLIN 




0010 


» 


SET 


FXD OR FLTG VECTOR EQUAL TG A LINEAR SEGMENT 




0011 


• 








0012 


• 




SETLIN SETS A FLOATING LINE SEGMENT. 




0013 


# 




XSTLIN SETS A FIXED LINE SEGMENT, 




0014 


* 








0015 


* 


LANGUAGE 


- FAP SUBROUTINES i FORTRAN—I I COMPATIBLE) 




0016 


• 


EQUIPMENT 


- 709 OR 7090 (MAIN FRAME ONLY) 




0017 


» 


STORAGE 


- 27 REGISTERS 




0018 


# 


SPEED 


- SETLIN 35 + 12.4*LX MACHINE CYCLES 




0019 


* 




XSTLIN 37 ♦ 8.0*LX LX = VECTOR LENGTH 




0020 


* 


AUTHOR 


- S.M. SIMPSON, AUGUST 1963 




0021 


• 








0022 


• 




USAGE 




0023 


• 








0024 


• 


TRANSFER VECTOR CONTAINS ROUTINES - {NONE) 




0025 


» 


AND FORTRAN SYSTEM ROUTINES - (NONE) 




0026 


• 








0027 


* 


FORTRAN USAGE 




0028 


* 


CALL SETLINC BASE, DELTA, LX, X) 




0029 


• 


CALL XSTLIN( I BASE, IDELTA,L IX, IX) 




0030 


• 








0031 


• 


IIMKUI5 






0G32 


* 








0033 


• 


BASE 


IS VALUE FOR X(l) 




0034 


* 


DELTA 


IS INCREMENT FOR SUCCESSIVE VALUES OF X(I) 




0035 


• 


LX 


IS DESIREO OUTPUT LENGTH. SHOULD EXCEED 0. 




0036 


» 








0037 


• 


I BASE 


IS VALUE FOR IXU) 




0038 


* 


IDELTA 


IS INCREMENT FOR SUCCESSIVE VALUES OF IXU5 




0039 


* 


LIX 


IS DESIRED OUTPUT LENGTH. SHOULD EXCEED 0 




0040 


• 








0041 


• 


OUTPUTS 


STRAIGHT RETURN WITH NO OUTPUTS IF LX OR LIX 


USTHN 1 


0042 


# 








0043 


• 


X(I) 


1 = 1. ..LX IS XU)= BASE ♦ (I-1)*DELTA 




0044 


• 








0045 


» 


IXU) 


1=1.. .LIX IS IX(I)= IBASE + (I-l)*IDELTA 




0046 


• 








0047 


• 


EXAMPLES 






0048 


» 








0049 


» 


1. INPUTS 


- X3 = 0.0 




0050 


* 


USAGE 


CALL SETLIN(0.,2.,5, XI) 




0051 


* 




CALL XSTLIN( 0, 2,5,1X1) 




0052 


* 




CALL SETLIN(2.,2.,1, X2) 




0053 


* 




CALL SETLIN(2.,2.,0, X3) 




0054 


• 


OUTPUTS 


- XK1...5) = 0., 2., 4., 6., 8. 1X1(1. * . 5)* 0 


,2,4*618 


0055 


• 




X2tl) * 2. X3 * 0. (NO OUTPUT CASE) 




0056 


• 








0057 


• 


PROGRAM FOLLOWS BELOW 




0058 


• 








0059 


» 








0060 


* 


NO TRANSFER 


VECTOR 




0061 




HTR 


0 XR4 




0062 




BCI 


1, SETLIN 




0063 


• 


PRINCIPAL ENTRY. SETLINC BASE, DELTA, LX,X ) 




0064 


SETLIN CLA 


FAD 




0065 


SETUP STO 


NEXT 




0066 




SXD 


SETLIN-2,4 




0067 




CLA 


4,4 




0068 




ADD 


Ki A(X)+l 




0069 




STA 


STORE 




0070 




CLA* 


2,4 DELTA 




0071 




STO 


TEMP 




0072 




CLA* 


3,4 LX 




0073 




TMI 


LEAVE 




0074 



•»•*»••«••*««*****«*•*#• PROGRAM LISTINGS * ♦###•*#•*♦##*♦**•»»*«#» 

» SETLIN ♦ * SETLIN * 
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(PAGE 2) (PAGE 2) 





TZE 


LEAVE 




0075 




STD 


TXL 




0076 


Kl 


CLA* 


lt4 


BASE 


0077 




A XT 


1,4 




0078 


• LOOP 








0079 


STORE 


STO 




***A(X)+1 


0080 


NEXT 


NOP 




= FAD TEMP OR ADD TEMP 


0081 




TXI 


*+l,4,l 




0082 


TXL 


TXL 


STORE, 4, »* 


**=LX 


0083 


* EXIT 








0084 


LEAVE 


LXD 


SETLIN~2»4 




0085 




TRA 


5,4 




0086 


* SECONDARY 


ENTRY. XSTL INC I BASE, I DELTA, L IX, IX) 


0087 


XSTLIN 


CLA 


ADD 




0088 




TRA 


SETUP 




0089 


* CONSTANTS, 


TEMPORARIES 




0090 


FAD 


FAD 


TEMP 




0091 


ADD 


ADD 


TEMP 




0092 


TEMP 


PZE 


«•,«»,** 


= DELTA 


0093 




END 






0094 



•*»«•«*««*•*••••••• PROGRAM LISTINGS **###*##»*#•*#»**»•*##*• 

SETLNS * * SETLNS * 

••»•«•••***»««•*•*• **»#*#«•**»*•#*•* ••••»#• 



» SETLNS (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO* 0123 

* FAP 0001 
•SETLNS 0002 

COUNT 150 0003 

LBL SETLNS 0004 

ENTRY SETLNS ( BASEl , DELTA1, LX I, XI, BASE2t DELTA2 ,LX2, X2% 4 J. , 0005 

» BASEN,DELTAN,LXN,XN) 0006 

* 0007 

» ABSTRACT 0008 

» 0009 

* TITLE - SETLNS 0010 

* SET LINEAR VECTORS, FIXED AND/OR FLOATING 0011 

* 0012 
» SETLNS IS A VARIABLE-LENGTH-CALLING-SEQUENCE SUBROUTINE » 0013 

* ONE CALL OF WHICH IS EQUIVALENT TO A SUCCESSION OF CALLS 0014 

* OF SUBROUTINES SETLIN (WHICH SETS A FLOATING VECTOR EQUAL 0015 

* TO A LINEAR SEGMENT) AND/OR XSTLIN (FOR FIXED POINT 0016 

* LINEAR SEGMENTS). THE ARGUMENTS OF SETLNS ARE DIVIDED 0017 
« INTO GROUPS OF LENGTH FOUR, EACH GR€UP REPRESENTING THE 0018 
« FOUR ARGUMENTS OF A DESIRED CALL SETLIN OR XSTLIN 0019 

* STATEMENT. SETLNS DECIDES TO USE XSTLIN ( SETL1N1 IF THE 0020 

* CONSTANT INCREMENT DELTA, INTERPRETED AS FIXED*' IS LESS 0021 

* THAN OR EQUAL TO (EXCEEDS) 10000, BUT XSTLIN IS ALWAYS 0022 

* USEO IF BIT 9 OF DELTA IS ZERO. 0023 

* 0024 
» LANGUAGE - FAP SUBROUTINE ( FORTRAN— I I COMPATIBLE) 0025 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0026 

* STORAGE - 39 REGISTERS 0027 
» SPEED - ABOUT 85 ♦ 12.4*LX MACHINE CYCLES FOR EACH FLTG. VECTOR 0028 

* PLUS 85 + 8.0*LX MACHINE CYCLES FOR EACH FBXED VECTOR 0029 
» WHERE LX = VECTOR LENGTH. 0030 

* AUTHOR - S.M. SIMPSCN JR., SEPTEMBER 1963 0031 
~ Ou32 

* USAGE 0033 

* 0034 

* TRANSFER VECTOR CONTAINS ROUTINES - SETL IN, XSTL IN 0035 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0036 

* 0037 
» FORTRAN USAGE OF SETLNS 0038 

* 0039 

* CALL SETLNS(BASE1,DELTA1,LX1,X1, BASE2,DELTA2,LX2,X2,..., 0040 
» 1 BASEN,DELTAN,LXN,XN) 0041 
» 0042 

* IS EQUIVALENT TO 0043 

* CALL SETLIN(BASE1,0ELTA1,LX1,X1) (OR XSTLIN IF DELTA1 0044 

* LSTHN 10001) 0045 

* CALL SETLIN(BASE2,DELTA2,LX2,XI) (OR XSTLIN IF DELCA2 0046 

* LSTHN 10001) 0047 

* ETC 0048 
» CALL SETLIN ( BASEN,DELTAN,LXN,XN) (OR XSTLIN IF DELTAN 0049 

* LSTHN 10001) 0050 

* 0051 
» SEE WRITEUPS OF SETLIN AND XSTLIN FOR INPUT-OUTPUT DETAILS 0052 
« 0053 
» EXAMPLES 0054 

* 0055 

* 1. ORDINARY CASES 0056 
» USAGE - CALL SETLNS ( 1 . , 1 . , 5, X 1 , 2,1,3,1X2, 3#1,1# IX3) 0057 

* OUTPUTS - XI ( I. ..5) = 1. ,2. ,3. ,4., 5. IX2( 1 . . . 35 = 2, 3, 4 IX3=*3 0058 

* 0059 

* 2. MORE UNUSUAL CASES 0060 
» INPUTS - OCTK=OCT 100000000000 (EXCEEDS 10000, DECIMAL, BUT BIT 9 0061 

* IS ZERO) 0062 

* USAGE - CALL SETLNS ( 20000, 10000, 3, 1X4, 0. ,. 0000000001 , 3* X5» 0063 

* 1 0,0CTK,3,X6) 0064 
» OUTPUTS - 1X4(1. ..3)^20000,30000, 40000 (CASE OF UPPER ttlMIT ON 0065 
» FIXED DELTA) 0066 
« X5( l..*3)=0., .0000000001, .0000000002 (SMALL FLTG DELTA) 0067 
» X6(l..*3)=0, OCT100000000000, OCT200000000000 (FIXED 0068 

* OPERATIONS! 0069 

* 0070 

* PROGRAM FOLLOWS BELOW 0071 
» 0072 
» 0073 

* TRANSFER VECTOR CONTAINS SETL IN, XSTL IN 0074 
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HTR 


0 


XR4 






0075 


BCI 


I, SETLNS 








0076 


• ONLY ENTRY. 


SETLNS! BASE1 


,DELTA1, LX1,X1,BASE2,DELTA2,LX2, 


X2 , • • • , 


0077 


• 


BASEN 


, DELT AN,LXN,XN ) 






0078 


SETLNS SXD 


SETLNS-2,4 








0079 


♦ SET RETURN 


LINKAGE 








0080 


NEXT CLA 


5,4 


1 PAST 4-GROUP 






0081 


STO 


SAVNXT 








0082 


CLA 


TRABAK 








0083 


STO 


5,4 








0084 


* DECIDE WHETHER TO USE SETLIN OR XSTLIN BY TESTING 


DELTA 




0085 


CLA» 


2,4 








0086 


* WE ASSUME FIXED POINT IF 


MAGNITUDEt AS FORTRAN— 1 1 


INTEGER) 


LSTHN iOOOl 


0087 


SSP 










0088 


CAS 


XBIGST 








0089 


NOP 










0090 


TRA 


FLTG 


FLOATING, MAYBE 






0091 


* USE XSTLIN 


IF FIXED POINT 








C092 


FXD CLA 


XST 








0093 


TRA 


GOOUT 








0094 


» USE SETLIN 


IF MAGNITUDE GRTHN* lOOOl, UNLESS BIT9 


=0 




0095 


FLTG ANA 


B9MASK 








0096 


TZE 


FXD 








0097 


CLA 


SET 








0098 


* GO SET THE 


LINE 








0099 


GOOUT STA 


TRAOUT 








0100 


SXA 


BACK, 4 








0101 


TRAOUT TRA 


• » 


**=$SETLIN OR $XSTLIN 






0102 


BACK AXT 


♦ *,4 


**=XR4 BEFORE SETLIN 






0103 


* RESTORE AND 


i CHECK FOR END 


OF STRING CNON TSX X,0) 






0104 


CAL 


SAVNXT 








0105 


SLW 


5,4 








0106 


TXI 


*+l,4,-4 








0107 


ANA 


AMASK 








0108 


LAS 


TSXZ 








0109 


TRA 


*+2 


NO MORE 






0110 


TRA 


NEXT 


MORE 






Oill 


* EXIT 










0112 


TRA 


1,4 


NO MORE 






0113 


• CONSTANTS TEMPORARIES 








0114 


TRABAK TRA 


BACK 








0115 


AMASK OCT 


777777700000 








0116 


TSXZ TSX 


0,0 








0117 


XBIGST PZE 


0,0,10001 








0118 


XST TSX 


$XSTLIN,4 








0119 


SET TSX 


$SETLIN,4 








0120 


B9MASK OCT 


000400000000 


EXTRACTS BIT 9 






0121 


SAVNXT PZE 


**,#*,** 








0122 


END 










C123 
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* SEVRAL I SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0948 

* FAP 0001 
•SEVRAL 0002 

COUNT 300 0003 

LBL SEVRAL 0004 

ENTRY SEVRAL (SUBRUA , Al , . . . , ANA, SUBRUBt Bit • • • * BNB , . ;. 44 ) 0005 

ENTRY PLURAL ( SUBROU, Al, A2, . . * , AN, Bl, 82, . *. , BN, . * *. . «i ) 0006 

* 0007 

* ABSTRACT — — 0008 

* 0009 

* TITLE - SEVRAL WITH SECONDARY ENTRY PLURAL, PSEUDO ENTRIES DO* IF 0010 

* OPERATE SEVERAL SUBROUTINES OR ONE SUBROUTINE REPEATf DL Y 0011 

* 0012 
» SEVRAL IS A VARIABLE LENGTH CALLING SEQUENCE SUBROUTINE 0013 

* WHOSE ARGUMENTS ARE DIVIDED INTO VARIBLE LENGTH GROUPS. 0014 
» THE FIRST ARGUMENT WITHIN EACH GROUP IS THE PROXY NAME, 0015 

* ESTABLISHED BY A PRIOR CALL LOCATE STATEMENT, OF A SUB- 0016 

* ROUTINE TO BE OPERATED BY SEVRAL, AND THE REMAINING 0017 

* ARGUMENTS IN THE GROUP ARE THOSE OF THAT SUBROUTINE. 0018 
« SEVRAL THUS OPERATES A GROUP OF SUBROUTINES SEQUENTIALLY* 0019 

* 0020 

* THE NUMBER OF ARGUMENTS ASSOCIATED WITH EACH PROXY 0021 

* NAME IS ASSUMED BY SEVRAL TO BE THE SAME AS THE ARGUMENT 0022 

* COUNT OF THE CALL SUBRU STATEMENT FOLLOWING ITS DEFINING 0023 

* CALL LOCATE STATEMENT, EXCEPT THAT IF THIS COUNT IS 0024 

* ZERO THEN SEVRAL COMPUTES THE NUMBER OF ARGUMENTS BY 0025 

* SCANNING DOWN THE ARGUMENTS IN THE GROUP UNTIL THE NEXT 0026 
» LEGITIMATE PROXY NAME APPEARS IOR TILL THE END OF 0027 

* SEVRAL*S ARGUMENTS IS REACHED). THIS SCHEME ALLOWS 0028 
» VARIABLE LENGTH CALLING SEQUENCE SUBROUTINES TO BE 0029 

* OPERATED BY SEVRAL. 0030 
» 0031 

* PLURAL ALLOWS THE REPEATED OPERATION OF THE SAME 0032 

* SUBROUTINE ON SUCCESSIVE ARGUMENT GROUPS. THE FIRST 0033 

* ARGUMENT OF SEVRAL IS THE SUBROUTINE PROXY NAME, AND 0034 

* THE REMAINING ARGUMENTS ARE A SEQUENCE OF EQUAfc— LENGTH 0035 

* BLOCKS GIVING THE SUCCESSIVE ARGUMENT GROUPS. PLURAL 0036 

* ASSUMES THE NUMBER OF ARGUMENTS PER GROUP TO BE THE SAME 0037 

* AS THAT OF THE CALL SUBROU STATEMENT FOLLOWING ITS 0038 

* DEFINING CALL LOCATE STATEMENT. 0039 

* 0040 

* THE ARGUMENT COUNTS FOR SEVRAL AND PLURAL MAY BE 0041 
» ARBITRARILY LARGE. 0042 

* 0043 
» DO IS A PSEUDO-SUBROUTINE WITH FUNCTIONS SIMILAR TO A 0044 
» FORTRAN DO STATEMENT, BUT OPERATING WITHIN THE CONFINES 0045 
» OF A CALL SEVRAL STATEMENT. LOOPS WITHIN LOOPS ARE 0046 

* NOT PERMITTED. 0047 

* 0048 

* IF IS A PSEUDO-SUBROUTINE WITH FUNCTIONS SIMILAR TO A 0049 

* FORTRAN IF STATEMENT, BUT OPERATING WITHIN THE CONFINES 0050 
« OF A CALL SEVRAL STATEMENT. PSEUDO-IF STATEMENTS ARE 0051 

* NOT PERMITTED INSIDE PSEUDO-DO LOOPS. 0052 

* 0053 
» LANGUAGE - FAP SUBROUTINES ( FORTRAN— 1 1 COMPATIBLE) 0054 

* EQUIPMENT - 709 OR 7090 I MAIN FRAME ONLY) 0055 

* STORAGE - 416 REGISTERS 0056 
« SPEED - SEVRAL TAKES AT LEAST 1500S MACHINE CYCLES AND ALSO 0057 

* ADDS A MIMIMUM OF 500 MACHINE CYCLES TO THE TIME 0058 

* REQUIRED BY EACH SUBROUTINE OPERATED. 0059 
» PLURAL ADOS A MINIMUM OF 2000 MACHINE CYCLES TO THE 0060 
» TIME REQUIRED FOR THE FIRST OPERATION OF THE 0061 

* SUBROUTINE AND A MINIMUM OF 100 FOR EACH 0062 

* ADDITIONAL OPERATION. 0063 

* DO REQUIRES RELATIVELY NEGLIGIBLE TIME FOR THE LOOP 0064 

* CONTROL LOGIC, AND IS OTHERWISE THE SAME AS SEVRAL* 0065 
» IF REQUIRES A MINIMUM OF 400*J MACHINE CYCLES WHERE 0066 
» J-l IS THE NUMBER OF SUBROUTINES BYPASSED 0067 
» AUTHOR - S.M. SIMPSON JR., SEPT 1963 0068 

* 0069 
» USAGE 0070 

* 0071 

* TRANSFER VECTOR CONTAINS ROUTINES - LOCATE, WHERE 0072 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0073 
» 0074 
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* FORTRAN USAGE OF SEVRAL 0075 

* CALL LOCATE(SUBRUA,SUBRUB,...,SUBRUZ) 0076 
» CALL SUBRA ( Rl ,R2» «,RNA) (ARGUMENT LIST OPTI@NAL) 0077 

♦ CALL SUBRB ( Rl , R2 , . . . , RNB) (ARGUMENT LIST OPTIONAL! 0078 
» . 0079 
» . 0080 

• CALL SU8RZ ( Rl tR2t •• . ,RNZ ) (ARGUMENT LIST OPTIONAL ) 0081 

♦ . 0082 

* . 0083 

♦ . 0084 
» CALL SEVRAL! SUBRUA, Al , A2 , . . . , ANA, SUBRUB,Bl,82, . ..,8NB, 0085 

• I ,SUBRUZ,Z1,Z2,...,ZNZ) 0086 

* 0087 

• WHERE 0088 
» 1. IF AN OPTIONAL ARGUMENT LIST IS PRESENT IT MUST BE THE 0089 
» SAME LENGTH AS THE CORRESPONDING LIST IN THE CALL SEVRAL 0090 

* STATEMENT. 0091 
» 2. THE ORDERING OF ARGUMENTS IN THE CALL LOCATE STATEMENT 0092 

• NEED NOT MATCH THE ORDERING OF SUBROUTINES IN THE CALL 0093 

* SEVRAL STATEMENT* 0094 

* 3. NONE OF THE SUBROUTINES TO BE OPERATED MAY USE INFORMATION 0095 

• BEYOND THE END OF ITS CALLING SEQUENCE. 0096 
» 4. IF THE PSEUDO-SUBROUTINES DO AND IF APPEAR AS SUBROUTINES 0097 

• TO BE OPERATED BY SEVRALt AS DESCRIBED BELOW, THEY NEED 0098 
» NOT APPEAR IN THE CALL LOCATE STATEMENT. 0099 

• 5. SEVRAL*S SECONDARY ENTRY PLURAL MAY NOT APPEAR 0100 

• AS ONE OF THE SUBROUTINES TO BE OPERATED BY SEVRAL. 0101 

♦ 6. THE SUBROUTINE ARGUMENTS MAY BE SUBSCRIPTED IN THI NORMAL 0102 
» FASHION. 0103 
» 0104 

• NOTE - A SLIGHT ELEMENT OF DANGER IS CONNECTED 0105 

• WITH NOT WRITING DOWN THE OPTIONAL ARGUMENT 0106 

* L151. It" IHt L15I 15 NU! WKlllfclM UUWIN l"UK A bUBKUUIlNfc ANU It VLVf 

• AT THE SAME TIME ONE OF THE ARGUMENTS OF THE SUBROUTINE INSIDE 0108 

• THE CALL SEVRAL STATEMENT CAN BE INTERPRETED AS THE PROXY NAME 0109 

* CF SOME SUBROUTINE WHICH HAS BEEN LOCATED BY A CALL 0110 

• LOCATE STATEMENT, THEN SEVRAL WILL BE CONFUSED, THE 0111 

• SUBROUTINE WILL BE OPERATED WITH ONE INCORRECT ARGUMENT^ 0112 

• AND, IF THE SUBROUTINE RETURNS, CONTROL WILL BE SENT TO AN 0113 

• ILLEGAL LOCATION, (THE LOCATION CONTAINING THE PROXY NAME OF THE 0114 
» NEXT SUBROUTINE). FOR VECTOR OR 0115 

* OTHER ARRAY ARGUMENTS ONLY THE FIRST ELEMENT NEED BE 0116 
» CONSIDERED IN THIS CONNECTION. 0117 

* 0118 

* FUNCTION 0119 

• THE ABOVE SEQUENCE IS EQUIVALENT IN FUNCTION TO 0120 
» 0121 

♦ CALL SUBRA(A1,A2,...,ANA) 0122 

* CALL SUBRB(B1,82,...,BNB) 0123 

• . 0124 
» . 0125 

• CALL SUBRZ(Z1,Z2,...,ZNZ) 0126 

♦ 0127 
» FORTRAN USAGE OF PLURAL 0128 
» 0129 
« CALL LOCATE (iSUBROU) 0130 

* CALL SUBRU ( Rl ,R2 , .. . ,RN) (PROPER ARGUMENT COUNT MANDATORY) 0131 
» . 0132 
» . 0133 
» . 0134 

* CALL PLURAL ( SUBROU , Ai , A2 , . . . , AN, Bl , B2, ...,BN, *Z1* 22* • ♦ . » ZN1 0135 

* 0136 

* FUNCTION 0137 

* THE ABOVE SEQUENCE IS FUNCTIONALLY EQUIVALENT TO 0138 

* 0139 

* CALL SUBRU (Al,A2,...,AN) 0140 
» CALL SUBRU(B1,B2,...,BN) 0141 

• . 0142 

* . 0143 
» . 0144 

* CALL SUBRU(Z1,Z2,...,ZN) 0145 

• 0146 

• FORTRAN USAGE OF DO (A DO LOOP INSIDE A CALL SEVRAL STATEMENT) 0147 
« 0148 

• 0149 
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• CALL SEVRAL ( ...... ,2HDO,NSUBS, I , ILO, I H I , SUBRUK , K i , K2 ♦ . . . , KNK, 0150 

• 1 SU8RUL,L1,L2,... t LNL,....*.,SUBRUF,Fl,F2,...,FNF, 0151 

• WHERE 0152 

* 1. NSUBS MUST EXCEED ZERO AND ILO MUST BE LSTHN* IHI 0153 
» 2. NONE OF THE SUBROUTINES IN THE LOOP MAY BE DO OR IF. 0154 

* 3. WE HAVE OMITTED THE REQUIRED CALL LOCATE STATEMENT WHICH 0155 

* IS SIMILAR TO THAT OF SEVRAL (NOTE THAT DO ITSELF NEED 0156 

* NOT BE LOCATED) 0157 
» 4. DO SHOULD ONLY BE CALLED IN THE ABOVE FASHION* NEViR BY 0158 

* A CALL DO STATEMENT. 0159 
» 5. CONFUSION MAY ARISE IF THE LOOP INDEX VARIABLE I 0160 

* HAS BEEN LEFT IN AN UNDEFINED STATE PRIOR TO THE 0161 
» CALL SEVRAL STATEMENT, BUT ONLY IN THOSE CASES WHERE I IS 0162 
» ALSO USED AS A SUBSCRIPT FOR ONE OR MORE OF THE ARGUMENTS 0163 
» INSIDE THE PSEUDO-DO LOOP. (FOR EXAMPLE THE INDEX 0164 

• VARIABLE OF A REAL DO LOOP IS UNDEFINED ONCE THE 0165 

* LOOP IS COMPLETED). IN SUCH CASES THE PSEUDO-DO 0166 

* LOOP CONTROL IS MAINTAINED BUT THE ARGUMENTS ARE 0167 

• IMPROPERLY SUBSCRIPTED. HENCE IN SOME INSTANCES IT MAY 0168 
» BE NECESSARY TO MAKE A DUMMY STATEMENT, SUCH AS 0169 

• 1= 0, JUST PRIOR TO THE CALL SEVRAL STATEMENT. II? THE 0170 

• LOOP VARIABLE IS DEFINED (UNDEFINED) PRIOR TO THE 0171 

* CALL SEVRAL STATEMENT IT REMAINS DEFINED (UNDEFINED) 0172 
» ON COMPLETION OF THE STATEMENT. 0173 

* 0174 

* FUNCTION 0175 

• THE ABOVE CALL STATEMENT IS EQUIVALENT IN FUNCTION TO 0176 

* 0177 

* . 0178 

• . 0179 
» . 0180 

• DO 10 I=ILO,IHI 0181 
» CALL SUBRK(K1,K2,...,KNK) 0182 

* CALL SUBRL(L1,L2,..*,LNL) 0183 

• . 0184 

• . 0185 

• . 0186 

♦ 10 CALL SUBRF(F1,F2,...,FNF) 0187 
» . 0188 

• . 0189 
» . 0190 
» WHERE 0191 
» 1. THE DO LOOP CONTAINS EXACTLY NSUBS CALL STATEMENTS. 0192 

* 2. THE LOOP VARIABLE IS AVAILABLE AS AN ARGUMENT TO THE 0193 
» SUBROUTINES IN THE LOOP. 0194 

• 3. ILO MAY BE ZERO OR NEGATIVE. 0195 

* 0196 

• FORTRAN USAGE OF IF (CONDITIONAL BRANCHING IN A CALL SEVRAL STATEMENT) 0197 

• CALL SEVRAL (•••••• , SUBRUK, Kl ,K2, . . . , KNK , 2H IF , X , NXNEG , NXZER jNXPOS , 0198 

* 1 SUBRUL,L1,L2,...,LNL, ) 0199 

» WHERE 0200 

» 1. X IS THE BRANCHING DETERMINANT (MAY BE FIXED POINT) 0201 

« 2. NXNEG, NXZER, AND NXPOS ARE NON ZERO 0202 

» 3. THE SEQUENCE SHOULD NOT OCCUR INSIDE A PSEUDO-DO L80P. 0203 

♦ 0204 

• 0205 
» FUNCTION 0206 
» THE ABOVE STATEMENT FUNCTIONS EQUI VALENTLY TO THE FOLLOiING 0207 
» FORTRAN PROGRAM (WHERE WE USE NEGATIVE STATEMENT NUMBERS) 0208 

♦ . 0209 

* . 0210 
» . 0211 
» -3 CALL ... 0212 
» -2 CALL ... 0213 

• -1 CALL SUBRK(K1,K2,...,KNK) 0214 
» IF (X) NXNEG,NXZER, NXPOS 0215 

* +1 CALL SUBRL(L1,L2,...,LNL) 0216 

* +2 CALL ... 0217 

♦ +3 CALL ... 0218 
» . 0219 
» . 0220 

* . 0221 

• WHERE THE BRANCHING 0222 
« 1. SHOULD NOT SEND CONTROL INSIDE A DO LOOP OR TO A PSEUDO 0223 
» CALL STATEMENT PRIOR TO THE FIRST SUBROUTINE OF THE CALL 0224 
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* SEVRAL STATEMENT. 0225 

* 2. MAY SEND CONTROL BEYONO THE LAST SUBROUTINE OF THE CALL 0226 
» SEVRAL STATEMENT. IN THIS CASE CONTROL RETURNS TO THE 0227 

* STATEMENT IMMEDIATELY FOLLOWING THE CALL SEVRAL STATf M£NT, 0228 
» REGARDLESS OF THE AMOUNT OF THE APPARENT OVERSHOOT. 0229 

* 0230 

* EXAMPLES 0231 

* 0232 

* FOR ILLUSTRATION WE SHALL USE THE FOLLOWING FOUR ELEMENTARY 0233 
» SUBROUTINES 0234 

* 0235 

* SUBROUTINE ADD (X,Y,SUMXY) 0236 

* SUMXY=X+Y 0237 
» RETURN 0238 

* AND 0239 
» SUBROUTINE MUL (X,Y,XTIMSY) 0240 

* XTIMSY=X*Y 0241 

* RETURN 0242 
» AND 0243 

* SUBROUTINE SUB (X,Y,XMNUSY) 0244 
» XMNUSY=X-Y 0245 
» RETURN 0246 
» AND 0247 

* SUBROUTINE FADD (I,J,K) 0248 

* K-I+J 0249 

* RETURN 0250 

* 0251 

* 1. EXAMPLES OF SEVRAL AND PLURAL WITHOUT DO OR IF 0252 

* 0253 
» USAGE - CALL LOCATE ( 3HADD, 3HMUL, 3HSUB ) 0254 

* CALL ADD (1,2,3) 0255 
« CALL MUL (1,2,3) 0256 
» Call Suo 0257 
» CALL FADD(l,2,3) 0258 

* C THEN ANY AMOUNT OF PROGRAM 0259 

* C FOLLOWED BY 0260 

* CALL SEVRAL ( 3HADD, 1 . , 1 . , Z , 3HMUL,Z^2. ,W, 0261 

* 1 3HADD,W,Z,U) 0262 
» CALL PLURAL ( 3HADD, 2. , 2., V, 3.,3.,X, 4.,4.m 0263 

* CALL SEVRAL ( 3HADD, 5. , 5., S, 3HSUB, S, 3. ,Dl, 0264 

* 1 3HSUB,D1,1.,D2) 0265 

* OUTPUTS - Z * 2. W * 4. U = 6. 0266 

* V » 4. X * 6. Y = 8. 0267 

* S * 10. Dl = 7. D2 * 6. 0268 

* 0269 
» 2. EXAMPLES OF DO AND IF 0270 

* 0271 
» INPUTS - XU...5) = 0.,0.,0.,0.,0. Yd.*. 5) » 1. , 2. , 3. ,4* ,5. 0272 
« USAGE - ASSUME THE SAME CALL LOCATE SEQUENCE AS IN EXAMPLE li, 0273 
« THEN 0274 
» 1=7 0275 

* CALL SEVRAL ( 3HADD, 1. , 1 ., Z, 2HD0, 2, 1 U5* 3HADD, 0276 
» I X(I),2.,XII), 3HSUB,Y(I),1J,Y(IH 0277 
» 2 3HMUL,2.,3.,U) 0278 

* W=-5. 0279 
» CALL SEVRAL ( 3HADD, 1., W,W, 2HIF, W,-l Ut3i< 3HAD0,i.# 0280 

* 1 l.,S, 2HIF,W,-3,-3,-3, 3HADB,K*S4P1 0281 
« 0282 

* OUTPUTS - Z=2. X(1...5)=2.,2.,2.,2.,2. Y( 1* ..5) =0., 1. 42. #3* *4. 0283 

* U * 6. W * 1. S = 2. P » 3. 0284 

* 0285 

* 3. SHOWING USE OF COMPUTED SUBSCRIPTS 0286 

* 0287 

* INPUTS - I=J=K=L=M=N=1 A<1..2) * l.,2. B( 1*.2, 1. .2 1*1. , 2. , 43. , 4* 0288 

* C( 1... 2,1. .2,1. .2) = l.,2.,,3.,4.,,,5.,6. ,|7.,8. 0289 
« 0290 

* USAGE - DIMENSION A( 2) , B( 2, 2 ) ,C ( 2, 2, 2) 0291 

* CALL SEVRALUHFADD, 1,1, I, 4HFADD, J, 1 1 J, 0292 

* 1 4HF ADD,K, 1 ,K, 4HF ADD, L , 1 , L , 4HFAD0, M, 1,M, 0293 

* 2 4HFADD,N, I ,N, 3HADD, AC I ) , AU ) , SA, 3HADD*B< J*K) » 0294 

* 3 B(J,K),SB, 3HADD,C(L,M,N),C<L,M,N),SC) 0295 

* 0296 

* OUTPUTS - I=J=K=L=M=N =2 SA = 4. SB = 8. SC = 16. 0297 

* 0298 
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» PROGRAM FOLLOWS BELOW 0299 

* 0300 

* 0301 
» TRANSFER VECTOR CONTAINS LOCATE, WHERE. 0302 

HTR 0 XR1 0303 

HTR 0 XR2 0304 

HTR 0 XR4 0305 

BCI 1 , SEVRAL 0306 

» PRINCIPLE ENTRY. SEVRAL ( SUBRUA t Alt A2t • • . t AN A , SU8RUB » Bl , B2 » w > BNB , 0307 

* ) 0308 

SEVRAL SXD SEVRAL-4,1 0309 

TSX LOCDOF, 1 0310 

» SEVRAL IS MERELY A LOOP TO 0PSUB1 0311 

TSXS TSX OPSUBl,l 0312 

TZE NOSUB TROUBLE 0313 

TPL TSXS 0314 

TRA LEAVE 0315 

* SECONDARY ENTRY. PLURAL ( SUBROU, Al, AN, Bl, BN, ... J. . ) 0316 
PLURAL SXD SEVRAL-4,1 0317 

TSX LOCDOF,! 0318 

» PLURAL IS ONE JUMP TO 0PSUB1 AND A LOOP TO 0PSUB2 0319 

TSX 0PSUBU1 0320 

TZE NOSUB TROUBLE 0321 

TSXP TSX TSXZCK,! IS THERE MORE 0322 

TRA *+2 YES 0323 

TRA LEAVE NO 0324 

TSX 0PSUB2,1 0325 

TRA TSXP (AC MUST=1) 0326 

* EXIT 0327 
LEAVE LXD SEVRAL-4,1 0328 

LXD SEVRAL-3,2 0329 

TRA 1,4 0330 

» STOP COMPUTER IF FAIL TO 0331 

* FIND SUBROUTINE, WITH AC=NAME OF 0332 
« SUBROUTINE. EXIT ON RESTART 0333 

NOSUB CLA* 1,4 0334 

HTR LEAVE 0335 

* INTERNAL SUBROUTINE TO LOCATE DO AND IF AND TO SET SUBSCRIPT PATCH 0336 
LOCDOF SXD SEVRAL-2,4 0337 

SXD SEVRAL-3,2 0338 

SXA SSLEVE,1 0339 

TSX $L0CATE,4 0340 

TSX DONAME ,0 0341 

TSX IFNAME,0 0342 

TSX G0T0D0*4 0343 

TSX 0,0 0344 

TSX 0,0 0345 

TSX 0,0 0346 

TSX 0,0 0347 

TSX G0T0IF#4 0348 

TSX 0,0 0349 

TSX 0,0 0350 

TSX 0,0 0351 

TSX 0,0 0352 

* ROUTINE TO SET UP SUBSCRIPT ROUTINE. 0353 

* 0354 

* LOOP TO SET SCAN FENCE. FENCE IS -(LOCATION 144 OCTAL) OR 0355 

* -{LOCATION OF AN SXD U,XR WHERE U PRECEEDS THE LOCATION) 0356 
« (USES XR1 AND XR2) 0357 

LXD SEVRAL-2,1 ORIG XR4 TO XR1 0358 

CALSS1 CAL -1,1 STARTS BEFORE TSX $SEVRAL,4 0359 

PAC 0,2 SAVE -U 0360 

ANA ATMASK 0361 

LAS SXDZ LOOKING FOR SXD 0362 

TRA »+2 0363 

TRA SCCK1 0364 

* CHECK FOR OCTAL 144 IF NOT SXD 0365 

PXA 0,1 0366 

CAS MIN144 0367 

NOP 0368 

TRA SETFNS 0369 

TXI CALSS1#1,1 LESS IF XR1 GREATHER THAN 144 0370 

» SET FENCE AND PROCEED 0371 

SETFNS SXD TXLISC»1 0372 

TRA NARCNT 0373 
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0374 



SCCK1 SXD 


♦♦1,2 




0375 


TXL 


SETFNS*lt«* 


• • = -u 


0376 


TXI 


CALSS1#1,1 




0377 


• FIND NARGUS » FULL ARGUMENT COUNT OF SEVRAL 


0378 


* (USES 


XR4,XR2,XRl) 




0379 


NARCNT LXD 


SEVRAL-2,4 




0380 


AXT 


0,2 


XR2 COUNTS 


0381 


TSXSS1 TSX 


TSXZCK»1 




0382 


TXI 


♦♦2,2,1 


YES 


0383 


TRA 


• ♦2 


NO MORE 


0384 


TXI 


TSXS5U4 r -l 




0385 


SXD 


NARGUS, 2 




0386 


» SET STA Y 


SCAN LIMIT 




0387 


CLA 


NARGUS 




0388 


ALS 


2 




0389 


ADD 


KD3 


4*NARGUS+3 


0390 


STD 


TXISS2 




0391 


LXD 


SEVRAL~2,4 




0392 


TXISS2 TXI 


♦♦1 ,4,»* 


*#=3+4*N ARGUS 


0393 


SXD 


TXLSCU4 




0394 


♦ RETURN TO 


SEVRAL OR PLURAL 




0395 


LXD 


SEVRAL-2,4 




0396 


LXD 


SEVRAL-3,2 




0397 


SSLEVE AXT 


♦ ♦,1 


»**XRl 


0398 


TRA 


1,1 




0399 


* 






0400 



• INTERNAL SUBROUTINE FOR OPERATING SUBROUTINES - 0PSUB1 

• LINKAGE WITH XR1, RETURNS TO 1,1 
» 

♦ ASSUMES XR4=-A WHERE 

♦ A+l TSX SUBRU,0 

• ETC 
*A*N+l TSX ARGN,0 

♦ A+M-2 VARY 
• 

* AND, 

• IF WHERE SETS NARGS GRTHN 0, THEN N*NARGS 

* OTHERWISE N IS COUNTED FROM A+l TO VARY, 
» COUNT STOPPING WHEN 

♦ VARY=NON TSX X,0 (END OF ALL ARGUMENTS) 

* OR VARY * TSX SUBROU,0 (NEXT SUBROUTINE) 
• 

* SETS XR4*-(A+N+1> #AC=+1 IF OK 

« XR4 UNDISTURBED, AC*0 IF NO FIND SUBRU 

* XR4 UNDISTURBED AC=-l IF A+l NOT TSX X,0 
* 

OPSUBl SXA 0LEVE,4 

SXA OLEVE+1,1 
TRA OFIND 

* SECONDARY ENTRY 0PSUB2 (ONLY USED BY PLURAL) 
* 

» SIMILAR BUT ASSUMES PREVIOUSLY FOUND SUBROUTINE AND NARGS 

* AND XR4 (=-A) OFF BY I 



» A+l TSX 
» ETC 

* A+N TSX 
♦A+N+l VARY 
• 

* LEAVES XR4 
• 

0PSUB2 TXI 
SXA 
SXA 
TRA 



♦♦1,4,1 

0LEVE,4 
OLEVE+1,1 
OSETUP 

♦ GO FIND SUBRU FROM 1,4 
OFIND TSX FIND,1 
TMI OLEVE 
TZE OLEVE 



ARG1,0 
AR6N 

- (A+N) (SAME RELATIVE POSITION) 

MAKE XR4 LIKE OPSUBl CASE 



NOT TSX X,0 
NOT TSX SUBRU, 0 



♦ IF FOUND LEAVE NARGS AS IS, PROVIDED IT IS NON ZERO 

ZET NARGS 
TRA OSETUP 

♦ OTHERWISE COUNT DOWN TO VARY, FIRST PUTTING LOC ASIDE. 



0401 
0402 
0403 
0404 
0405 

0407 
0408 
0409 
0410 
0411 
0412 
0413 
0414 
0415 
0416 
0417 
0418 
0419 
0420 
042 1 
0422 
0423 
0424 
0425 
0426 
0427 
0428 
0429 
0430 
0431 
0432 
0433 
0434 
0435 
0436 
0437 
0438 
0439 
0440 
0441 
0442 
0443 
0444 
0445 
0446 
0447 
0448 



•«•*»••*•*••••*••••**«*• PROGRAM LISTINGS #*####»»*##•##***♦**»*** 

* SEVRAL * # SEVRAL * 

*•*•*••••*•*•*•••*•*«**» 4 ****»*»••**«•«*« ••*•••» 

(PAGE 7) (PAGE 7) 



CLA 


LOC 




0449 


STO 


LOCSAV 




0450 


AXT 


-1,1 




0451 


ONEHOR TXI 


•♦1,1,1 


(XRl STARTS AT ZERO) 


0452 


SXA 


OCSVl,l 




0453 


TXI 


♦♦1,4,-1 


(XR4 STARTS AT TSX ARG1,0) 


0454 


TSX 


FIND,1 




0455 


OCSV1 AXT 


**»1 




0456 


TZE 


ONEMOR 


(ORDINARY TSX X,0) 


0457 


» STORE THE 


COUNTED NARGS AND RESTORE LOC 


0458 


SXD 


NARGS, 1 




0459 


CLA 


LOCSAV 




0460 


STO 


LOC 




0461 


• SETUP 






0462 


OSETUP CLA 


OLEVE 


-A 


0463 


PAC 


0,4 


♦ A 


0464 


SXA 


OCLA, 4 


(SET ASIDE) 


0465 


CLA 


NARGS 




0466 


POC 


0,1 


-NARGS 


0467 


SXD 


OTXI.l 




0468 


ARS 


18 


♦NARGS 


0469 


ADD 


OCLA 




0470 


ADD 


K2 




0471 


STA 


OCLA 


A+NARGS+2 


0472 


• GO TO SUBSCRIPT ROUTINE ONLY IF NECESSARY 


0473 


ZET 


NARGS 


NOT IF NARGS=0 


0474 


TRA 


SCRPTS 




0475 


• SET UP RETURN FROM SUBROUTINE 


0476 


OCLA CLA 


*• 


»*sA+NARGS+2 


0477 


STO 


SAVNXT 




0478 


CLA 


TRABAK 




0479 


STO* 


OCLA 




0480 


» NOW GO OPERATE SUBROUTINE 




0481 


LXA 


OLEVE, 4 




0482 


TXI 


*+l,4,-l 


XR4 = -(A+l) 


0483 


SXA 


OLEVE, 4 




0484 


CLA 


LOC 




0485 


ARS 


18 




0486 


STA 


♦♦I 




0487 


TRA 


• * 


**=LOC 


0488 


• AFTER RETURNING , RESTORE 


NEXT INSTRUCTION, 


0489 


* SET AC=1 , 


ADJUST XR4 TO - 


<(A+N+l)t AND EXIT 


0490 


OBAK CLA 


SAVNXT 




0491 


STO* 


OCLA 




0492 


CLA 


Kl 




0493 


LXA 


OLEVE, 4 


GIVES XR4 = -A-l 


0494 


OTXI TXI 


OLEVE+1,4,** 


***-(NARGS) 


0495 


* EXIT 






0496 


OLEVE AXT 


**,4 


**=XR4 {-A THEN -A-l) 


0497 


AXT 


**,1 


**=*XR1 


0498 


TRA 


1.1 




0499 


» 






0500 


* INTERNAL 


SUBROUTINE FIND 




0501 


• 






0502 


* LINKAGE WITH XRl RETRUNS TO 1,1 


0503 


* 






0504 


* DETERMINES IF 1,4 IS 




0505 


* 1. 


TSX SUBRU,0 


- SETS AC=+1 


0506 


* OR 2. 


TSX X,0 


- SETS AC= 0 


0507 


* OR 3. 


ANYTHING ELSE 


- SETS AC=-l 


0508 


» 






0509 


* FOR CONDITION 1. IT ALSO 


SETS LOC, AND NARGS 


0510 


* 






0511 


FIND SXA 


FND0UT,4 




0512 


SXA 


FNDOUT+1,1 




0513 


* IS IT TSX 


X,0 




0514 


TSX 


TSXZCK,! 




0515 


TRA 


ASKW 


YES 


0516 


CLS 


Kl 


NO 


0517 


TRA 


FNDOUT 




0518 


* IF SO, ASK WHERE 




0519 


ASKW CLA 


1,4 




0520 


STA 


FTSX 




0521 


TSX 


$WHERE#4 




0522 


FTSX TSX 


**#0 


**=SUBRU 


0523 
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TSX 


IANS,0 








0524 


TSX 


LOCO 








0525 


TSX 


NARGS ,0 








0526 


* WHATS THE ANSWER 








0527 


PXD 


0,0 




AC=0 




0528 


NZT 


IANS 








0529 


CLA 


Kl 




FOUND 




0530 


* RETURN 










0531 


FNDOUT AXT 


**,4 




**=XR4 




0532 


AXT 


**,1 




**=XR1 




0533 


TRA 


1,1 








0534 


* 










0535 


* INTERNAL SUBROUTINE TSXZCK 




0536 


* LINKAGE 


XR1 








0537 


• IF 1,4 IS 


TSX X,0 


RETURNS TO 1,1 




0538 


* OTHERWISE 




RETURNS TO 2,1 




0539 


* OESTROYS AC 








0540 


TSXZCK CAL 


1,4 








0541 


ANA 


AMASK 








0542 


LAS 


TSXZ 








0543 


TRA 


*+2 








0544 


TRA 


1,1 




YES 




0545 


TRA 


CM 




NO 




0546 


• 










0547 


• THIRD ENTRY. 


DOtNSUBS, 


It 


ILO, IHI) ISUBENTRY OF 


SEVRAL I 


0548 


• 










0549 


» AT TIME OF ENTRY HERE, 


WE HAVE XR4 IN OLEVE = -<A+1) * -B 


0550 


* 










0551 


* B = A+l 


TSX $D0, 


4 






0552 


* A+2 


TSX NSUBS, 


0 =-3,2 RELATIVE TO 


C 


0553 


* A + 3 


TSX 1,0 




=-2,2 




0554 


* A+4 


TSX ILO, 


0 


=-1,2 




0555 


» C * A+5 


TSX IHI, 


0 


= 0,2 




U556 


» A+6 


TRA OBAK 




= 1,2 




0557 


• 










0558 


* 










0559 


* XR2 WILL 


BE SET AND 


HELD AT -C 




0560 


» 










0561 


» 










0562 


* FIRST AOVANCE XR2 TO -C 




-(B+4) » -(A+N+l) 




0563 


* AND RESTORE 


C+l FROM SAVNXT 




0564 


DO LXA 


0LEVE,2 




-( A+l ) = -B 




0565 


TXI 


*+l,2,-4 




-C 




0566 


CLA 


SAVNXT 








0567 


STO 


1,2 




( SAME AS STO* OCLA) 




0568 


* SET ILO 










0569 


CLA* 


-1*2 




ILO 




0570 


STO* 


-242 




TO I 




0571 


* INITIALIZE FOR NEXT LOOP 






0572 


NXLCOP PXD 


0,2 








0573 


PDX 


0,4 




XR4 STARTS AT -C, EACH 


LOOP 


0574 


CLA* 


-3,2 




NSUBS 




0575 


PDX 


0,1 




XR1 COUNTS SUBS 




0576 


* INNER LOOP 










0577 


NXSUB SXA 


DSVl,l 








0578 


TSX 


OPSUBWl 








0579 


TZE 


NOSUB 




TROUBLE 




0580 


TPL 


DSV1 




OK 




0581 


TRA 


LEAVE 




END OF STRING 




0582 


DSV1 AXT 


**,1 




**=XR1 




0583 


TlX 


NXSUB, 1,1 








0584 


* INDEX THE LOOP VARIABLE 








0585 


CLA* 


-2,2 








0586 


ADD 


KD1 








0587 


STO* 


-2,2 




1 = 1*1 




0588 


CAS* 


0,2 








0589 


TRA 


TSXS 




EXIT, BACK TO SEVRAL 




0590 


NOP 










0591 


TRA 


NXLCOP 








0592 


• 










0593 


* FOURTH ENTRY. IF(X,NXNEG 


,NXZER,NXPOS) 




0594 


* 










0595 


* ASSUME XR4 


= -A 








0596 


* A TSX 


2HIF,0 








0597 


* A+l TSX 


X,0 








0598 
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A+2 TSX NXNEG ,0 




0599 


A+3 TSX NXZER,0 




0600 


A+4 TSX NXPOS,0 




0601 


A+5 TRA OBAK 




0602 






0603 


LEAVES 1,4 POSITIONED FOR 


PROPER SUBROUTINE 


0604 


AND RETURNS TO SEVRAL 




0605 


DESTROYS XR1 AND XR2 




0606 






0607 


PICK UP PROPER N ACGCRDING 


TO X 


0608 


IF CLA» 1,4 


X 


0609 


LDQ* 4,4 


NXPOS 


0610 


TZE INZER 




0611 


TPL IXCA 




0612 


LDQ* 2,4 


NXNEG 


0613 


IXCA XCA 




0614 


TRA IGOTN 




0615 


INZER CLA* 3,4 


NXZER 


0616 


SET FORWARD OR BACKWARD AND POSITION XR4 


0617 


IGOTN PDX 0,2 


(XR2 WILL COUNT JUMPS ) 


0618 


TXI *+l,4,l 


INITIALIZE XR4 TO -(A-l). 


0619 


LXA Kl,l 


XR4 IS BUMPED BY +1 


0620 


TMI ISXD 


FOR N NEGATIVE, 


0621 


PXA 0,1 


OTHERWISE, 


0622 


PAC 0,1 


BY -1. 


0623 


TXI *+l,4,-4 


AND XR4 STARTS AT -(A+3) 


0624 


ISXD SXD ITXI,1 




0625 


RESTORE FROM SAVNXT 




0626 


CLA SAVNXT 




0627 


STO* OCLA 




0628 


LOOP 




0629 


ITXI TXI *+l t 4,«« 


*»=-l OR +1 


0630 


TSX FIND,1 




0631 


TZE ITXI 


ARGUMENT 


0632 


TMI LEAVE 


END OF STRING 


0633 


COUNT SUBROUTINES, FOR AC= 


I 


0634 


TIX ITXI, 2,1 




0635 


EXIT 




0636 


TRA TSXS 




0637 



« SUBSCRIPT SETTING ROUTINE 
• 

« WE HAVE A+l * TSX SUBRU,0 

* A+2 » TSX ARG1 ,0 

* ETC 

* A+NARGS+l « TSX ARGN, 0 
* 

* THE SUBSCRIPT ROUTINE EXAMINES THE FORTRAN PROGRAM PRIOR TO 

* THE TSX $SEVRAL*4 , LOCKING FOR STA Y OPERATIONS WITH Y IN THE RANGE 

* A+2 TO A+NARGS+1. (THE SCAN FOR STAY-S IS LIMITED TO 3+4*NARGU5 

* REGISTERS,) FOR EACH SUCH STA Y FOUND, IT TRACKS THE PERTINENT 

* INSTRUCTIONS BACK TO THEIR SOURCE, AND THEN EXECUTES THESE 

* INSTRUCTIONS. 



• 

SCRPTS SXA 


SCLEVE,1 




SXA 


SCLEVE+1,2 




SXA 


SCLEVE+2,4 




* FIRST SET LIMITS ON THE 


STA Y INSTRUCTION, IN STAALO, 


LXA 


0LEVE,4 


-A 


TXI 


*+l,4,-l 


-( A+l) 


PXA 


0,4 




PAC 


0,4 


XR4=A<TSX SUBRU,03 


SXA 


STAAL0,4 




LXD 


NARGS,2 




SXD 


*+l,2 




TXI 


*+l ,4,** 


»*-NARGS 


SXA 


STAAHI,4 


A(TSX SUBRU,0)+NARGS 


» INITIALIZE - 


( BETA+1 } TO 


-A(TSX $SEVRAL,4) 


LXD 


SEVRAL-2,4 




SXA 


AXTSCH4 




* LOOP TO FIND 


NEXT STA Y, 


Y IN ADDRESS LIMITS, IF ANY 


AXTSCi AXT 


#♦,4 


»»=-(BETA+l) 


TXI 


♦♦1,4,1 


-BETA 


CALSC1 CAL 


0,4 




ANA 


AMASK 


KNOCK OUT ADDRESS ONLY 



0638 
0639 
0640 
0641 
0642 
0643 
0644 
0645 
0646 
0647 
0648 
0649 
0650 
0651 
0652 
0653 
0654 
0655 
0656 
0657 
0658 
0659 
0660 
0661 
0662 
0663 
0664 
0665 
0666 
0667 
0668 
0669 
0670 
0671 
0672 
0673 
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LAS 


STAZ 


IS IT STA 


0674 




TRA 


NOTSTA 


NO 


0675 




TRA 


ISSTA 


YES 


0676 


NOTSTA 


TXI 


*+l,4,l 


NO 


0677 


TXLSC1 


TXL 


CALSC1«4,»» 


«**SCAN LIMIT FOR STA Y 


0678 


» SUBSCRIPT SETTING COMPLETED 


0679 


SCLEVE 


AXT 


♦*,1 




0680 




AXT 


• ••2 




0681 




AXT 


*»,4 




0682 




TRA 


OCLA 




0683 


« IF IT IS 


STA Y t CHECK Y. 




0684 


ISSTA 


CAL 


0,4 


GET STA Y 


0685 




LAS 


STAALO 


MUST EXCEED STAALO 


0686 




TRA 


HICHEK 




0687 




NOP 






0688 




TRA 


NOTSTA 


IGNORE IF NOT IN RANGE 


0689 


HICHEK 


LAS 


STAAHI 


ANO BE LSTHN= STAAHI 


0690 




TRA 


NOTSTA 


IGNORE IF NOT IN RANGE 


0691 




NOP 




GOT IT 


0692 


» GOT I 


ONE. 


SAVE BETA AND 


PROCEED, 


0693 




SXA 


AXTSCH4 


GOT IT 


0694 


* SET 


THE STA Y, SUB #-1, 


PXA X,XRA 


0695 


* INSTRUCTIONS FOR LATER EXECUTION 


0696 




SLW 


XEC1 


STA Y 


0697 




CLA 


-1#4 


SUB »-l 


0698 




STO 


XEC2 




0699 




CLA 


-2,4 


GIVES PXA X,XRA 


0700 




STO 


XEC3 




0701 


* LOOK 


FOR 


PRECEEDING LXD 


A,XRA (MUST EXIST) 


0702 




TXI 


*+l ,4,3 


(LOOK BEFORE PXA) 


0703 




TSX 


LXDTSC il 


(AC HAS PXA X,XRA) 


0704 




HPR 




ILLEGAL 


0705 


» STORE IT 


FOR EXECUTION, 


THEN CHECK PRECEEDING TSX SCRSUB,4 


0706 




STO 


XEC4 




0707 




TSX 


CKTSXS* 1 




0708 




TRA 


CASE2 


NO 


0709 


• CASE 


1. 


EXECUTE THE TSX 


SCRSUB,4 ROUTINE 


0710 


» AND 


THEN 


GO TO LXD, PXA, SUB, STA SEQUENCE 


0711 




TSX 


XEC7,1 




0712 




TRA 


XEC4 




0713 


» CASE 


2. 


XR4 HAS -GAMMA. SAVE —( GAMMA-1) 


0714 


CASE2 


TXI 


•♦1,4,1 




0715 




SXA 


CAS2X4,4 




0716 


• LOOK 


FOR 


PRECEEDING STO 


A 


0717 




CLA 


XEC4 




0718 




STA 


STOADD 




0719 




STA 


STQADD 




0720 




STA 


SXDADD 




0721 




CLA 


STOADD 




0722 




LOQ 


NOMASK 




0723 




TSX 


INSCAN,1 




0724 




LXO 


N0MASK,4 


NO FIND (PRETEND FOUND IN 1) 


0725 




SXD 


L0CST0*4 




0726 


» LOOK 


FOR 


PRECEEDING STQ 


A 


0727 




LXA 


CAS2X4,4 




0728 




CLA 


STQADD 




0729 




TSX 


INSCAN,1 




0730 




LXD 


N0MASK#4 


NO FIND 


0731 




SXD 


L0CSTQ*4 




0732 


• LOOK 


FOR 


PRECEDING TSX SCRSUB,4 LXD A, XRB COMBO 


0733 




LXA 


CAS2X4*4 




0734 




CLA 


XEC4 




0735 




TSX 


LXDASC1 




0736 




TRA 


LXDSC1 


NO 


0737 


* POSSIBLY 






0738 




TSX 


CKTSXS, 1 




0739 


LX0SC1 


LXO 


N0MASK#4 


NO FIND 


0740 




SXD 


LOCLXD ,4 




0741 




STA 


CAS2.1 


AND SAVE SCRSUB 


0742 


* LOOK 


FOR 


PRECEDING COMBO 


OF FORM 


0743 


• 


TSX 


SCRSUB,4 ,LXD B 


,XRB,...,SXD A, XRB 


0744 




LXA 


CAS2X4,4 




0745 




CLA 


SXDADD 




0746 




TSX 


LDQTM , 1 




0747 




TRA 


LXDSC2 


NO 


0748 
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♦ POSSIBLY, 


CHECK FOR THE LXD B,XRB 


0749 


STO 


XEC5 


0750 


TXI 


♦+1,4,1 


0751 


TSX 


LXDTSC , 1 


0752 


TRA 


LXDSC2 NO 


0753 


» POSSIBLY, 


CHECK FOR THE TSX SCRSUB, 4 


0754 


STO 


XEC6 


0755 


TSX 


CKTSXS, 1 


0756 


LXOSC2 LXD 


N0MASK,4 NO 


0757 


SXD 


L0CSXD,4 (SCRSUB REMAINS IN XEC7) 


0758 


* NOW FIND 


WHICH CAME FIRST 


0759 


* CASE 2.3 


IF STO OR STQ CAME FIRST 


0760 


» CASE 2.1 


IF LXD CAME FIRST 


0761 


» CASE 2.2 


IF SXD CAME FIRST 


0762 


• (ADDRESS SIZE SENSE IS REVERSED, THEREFORE 


0763 


* LOOKING FOR SMALLEST) 


0764 


* FIND FIRST OF STO AND STQ 


0765 


CLA 


LOCSTO 


0766 


CAS 


LOCSTQ 


0767 


CLA 


LOCSTQ 


0768 


NOP 




0769 


» COMPARE IT AGAINST LXD AND SXD 


0770 


CAS 


LOCLXD 


0771 


TRA 


NOT2.3 


0772 


NOP 




0773 


CAS 


LOCSXD 


0774 


TRA 


NOT2.3 


0775 


HPR 


STOP ON UNDEFINED SUBSCRIPT 


0776 


• CASE 2.3. 


GO DIRECTLY TO LXD, PXA, SUB, STA SEQUENCE 


0777 


TRA 


XEC4 


0778 


» IS IT 2.1 


OR 2.2 


0779 


NOT2.3 CLA 


LOCSXD 


0780 


CAS 


LOCLXD 


0781 


TRA 


CAS2.1 


0782 


HPR 


SHOULDNT HAPPEN 


0783 


» CASE 2.2 


OPERATE TSX SCRSUB, 4 LXD B,XRB SXD A,XRB 


0784 


♦ AND GO TO 


LXD,PXA,SUB,STA SEQUENCE 


0785 


TSX 


XEC7,1 


0786 


XEC6 NOP 


= LXD B, XRB 


0787 


XEC5 NOP 


* SXD A, XRB 


0788 


TRA 


XEC4 


0789 


» CASE 2.1 


OPERATE TSX SCRSUB, 4, AND GO TO 


0790 


» LXD, 


PXA, SUB, STA SEQUENCE 


0791 


CAS2.1 A XT 


**,1 »«=SCRSUB FOR 2.1 


0792 


SXA 


XEC7,1 


0793 


TSX 


XEC7,1 


0794 


♦ OPERATE THE LXD#PXA#SUB»STA SEQUENCE 


0795 


» AND RETURN TO SCAN FOR NEXT STA Y. 


0796 


XEC4 NOP 


* LXD A, XRA 


0797 


XEC3 NOP 


= PXA X,XRA 


0798 


XEC2 NOP 


= SUB *-l 


0799 


XEC1 NOP 


= STA Y 


0800 


TRA 


AXTSC1 


0801 


• 




0802 


• 




0803 


» INTERNAL 


SUB TO CHECK IF -1,4 IS TSX SCRSUB, 4 


0804 


» IF NOT RETURNS TO 1,1 


0805 


• IF SO RETURNS TO 2,1 SETTING XEC7 TO SCRSUB 


0806 


* 


AND AC ADDRESS TO SCRSUB 


0807 


• 




0808 


» XEC7 


IS SET IN ANY CASE 


0809 


• USES 


XR2, LEAVES XR4 UNDISTURBED 


0810 


• 




0811 


CKTSXS CAL 


-1,4 POTENTIAL TSX SCRSUB, 4 


0812 


STA 


XEC7 SET SCRSUB 


0813 


STA 


CALSCK 


0814 


PAC 


0,2 -(SCRSUB) TO XR2 


0815 


ANA 


AMASK 


0816 


LAS 


TSXZ4 


0817 


TRA 


»+2 


0818 


TRA 


CKADDS GOT IT, MAYBE 


0819 


• FAILURE 




0820 


CTSXSX TRA 


1,1 


0821 


• FURTHER CHECK ON ADDRESSES 


0822 


CKADDS SXD 


TXLSC2#4 


0823 
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TXLSC2 TXH CTSXSX^2,«* •* » — THET A 0824 

• ALMOST CERTAINLY HAVE IT. BUT WE NEED TO VERIFY THAT THE SUBROUTINE 0825 
» CONTAINS AN STO A WHERE A * ADDRESS PORTION OF 0,4 (THIS VERIFICATION 0826 
» MAY BE UNNECESSARY BUT IS INSERTED TO GUARD AGAINST CONFUSIDN BETWEEN 0827 
» SCRIPT SETTING SUBROUTINES AND OTHER TYPES OF INTERNAL FORTRAN 0828 

* SUBROUTINES). 0829 



CLA 


0,4 (LXD A,XR) 


0830 


STA 


STOADD 


0831 


CALSCK CAL 


*• #*-SCRSUB INIT 


0832 


LAS 


STOADD 


0833 


TRA 


*+2 NO 


0834 


TRA 


ISSUB FINAL VERIFICATION 


0835 


» INDEX FOR NEXT CHECK BUT STOP AT FIRST TRA INSTRUCTION 


0836 


CAL 


CALSCK 


0837 


ACL 


Kl 


0838 


SLW 


CALSCK 


0839 


CAL* 


CALSCK 


0840 


ANA 


ATMASK 


0841 


LAS 


TRAZ 


0842 


TRA 


*+2 


0843 


TRA 


CTSXSX EXIT IF HIT A TRA 


0844 


TRA 


CALSCK BACK 


0845 


• SUCCESS 




0846 


ISSUB CLA 


XEC7 


0847 


TRA 


2,1 


0848 


» 




0849 


• INTERNAL SUB 


, SCANNING BACK FROM 0,4 


0850 


• LOOKING FOR 


LXD A,XR 


0851 


* WHERE XR IS 


ARBITRARY, A IS IN AC ADDRESS 


0852 


* RETURNS TO 1 


,1 IF NOT FOUND 


0853 


» TO 2 


,1 IF FOUND, WITH AC^FULL LXD A,XR 


0854 


LXDASC STA 


LXDAOD 


0855 


CLA 


LXDADD 


0636 


LDQTM LDQ 


TMASK 


0857 


TRA 


INSCAN 


0858 


• 




0859 


* 




0860 


• INTERNAL SUB 


, SCANNING BACK FROM 0,4 


0861 


» LOOKING FOR 


LXD A,XR 


0862 


• WHERE A IS ARBITRARY, XR IS IN AC TAG 


0863 


• RETURNS TO 1 


,1 IF NOT FOUND 


0864 


• TO 2 


,1 IF FOUND, WITH AC^FULL LXD A,XR 


0865 


LXDTSC SiTT 


LXDTAG 


0866 


CLA 


LXDTAG 


0867 


LDQ 


AMASK 


0868 


* 




0869 


• 




0870 


* 




0871 


* INTERNAL ROUTINE SCANNING BACKWARDS FROM 0,4 


0872 


» 




0873 


* LOOKS FOR AC 


MASKED BY MQ 


0874 


* RETURNS TO 1 


,1 IF DONT FIND 


0875 


» TO 2 


,1 IF FIND, WITH FULL INSTRUC IN AC 


0876 


* MQ UNDISTURBED 


0877 


INSCAN STO 


SOMINS 


0878 


STQ 


SOMASK 


0879 


CALISC CAL 


0,4 


0880 


ANA 


SOMASK 


0881 


LAS 


SOMINS 


0882 


TRA 


*+2 


0883 


TRA 


GOTINS 


0884 


» CHECK LIMIT 




0885 


TXI 


•♦1,4,1 


0886 


TXLISC TXL 


CALISC #4, *♦ ** = SCFENS 


0887 


• FAILURE EXIT 




0888 


TRA 


1,1 


0889 


♦ SUCCESS EXIT 




0890 


GOTINS CLA 


0,4 


0891 


TRA 


2,1 


0892 


« INTERNAL SUBROUTINE (RETURN TO 1,1) 


0893 


* TO EXECUTE THE SUBROUTINE AT SCRSUB 


0894 


XEC7 XEC 


** ** STARTS AT SCRSUB 


0895 


STO 


XECTMP 


0896 


CAL 


XEC7 


0897 


ACL 


Kl 


0898 
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SLW 


XEC7 




0899 




CAL* 


XEC7 


END CHECK 


0900 




LAS 


TRA14 




0901 




TRA 


*+2 




0902 




TRA 


1,1 




0903 




CLA 


XECTMP 




0904 




TRA 


XEC7 




0905 


* CONSTANTS, 


TEMPORARIES 




0906 


AMASK 


OCT 


777777700000 




0907 


TSXZ 


TSX 


0,0 




0908 


IFNAME 


BCI 


It IF 




0909 


DONAME 


BCI 


1,D0 




0910 


GOTOOO 


TTR 


DO 




0911 


GOTOIF 


TTR 


IF 




0912 


TRABAK 


TRA 


OBAK 




0913 


K2 


PZE 


2 




0914 


Kl 


PZE 


1 




0915 


KOI 


PZE 


0,0,1 


( USED BY DO) 


0916 


NOMASK 


OCT 


777777777777 




0917 


ATMASK 


OCT 


777777000000 




0918 


TMASK 


OCT 


777777077777 




0919 


KD3 


PZE 


0,0,3 




0920 


MIN144 


PZE 


-100,0,0 




0921 


STA2 


STA 


0 




0922 


TSXZ4 


TSX 


0,4 




0923 


TRA14 


TRA 


1,4 




0924 


TRAZ 


TRA 


0 




092 5 


SXDZ 


SXD 


0,0 




0926 


IANS 


PZE 


0,0, ** 


FROM WHERE 


0927 


LOC 


PZE 


0,0,** 


FROM WHERE 


0928 


NARGS 


PZE 


0,0,** 


FROM WHERE AND FROM COUNTING 


0929 


SAVNXT 


PZE 


»« , #* , *» 


TEMPORARY 


0930 


LOCSAV 


PZE 


0,0,** 


TEMP FOR LOC 


0931 


STAALO 


STA 


• * 


**=A(TSX SUBRU,0) 


0932 


STAAHI 


STA 


»* 


**=A(TSX SUBRU,0)*NARGS 


0933 


LXOTAG 


LXO 


0,** 




0934 


LXDADD 


LXD 


**,0 




0935 


STOADD 


STO 


** 




0936 


STQADD 


STQ 


»♦ 




0937 


SXDADD 


SXD 


**,0 




0938 


LOCSTO 


PZE 


0,0,** 




0939 


LOCSTQ 


PZE 


0,0,** 




0940 


LOCLXD 


PZE 


0,0,** 




0941 


tOCSXD 


PZE 


0,0,** 




0942 


CAS2X4 


PZE 


*• 


XR4 FOR CASE 2 


0943 


SOMASK 


PZE 


«*,*», *» 




0944 


SOMINS 


PZE 


«*,»», *• 




0945 


NARGUS 


PZE 


0,0,** 




0946 


XECTMP 


PZE 


*» # #* 




0947 




END 






0948 
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» SETS8V * 
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REFER TO 

LOCATE 
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♦ IETSBV * 
**•****»•*•*•**»*•••**•» 

REFER TO 
LOCATE 



♦ SETUP * 
*•***•***•*#****«•«#*«** 

REFER TO 
LOCATE 



«**#*•*•* •••*«»»«* *«»«*» 
« SETUP * 
#♦##*****#»*»###*•**♦»♦* 

REFER TO 
LOCATE 



**#**«*#»»*#*»♦*♦♦***»»* 

« SETVCP * 
»*****«*♦***«»****♦*♦*♦♦ 

REFER TO 
SETKP 



ft****ft********««****««»* 
* SETVCP * 
»*«*««««**«****»*»*•«*** 

REFER TO 
SETKP 



•*••«•*»•»****•#»••***#» 

• SETVEC * 

• ••«*••»«*•-»**»»»#»***•* 

REFER TO 
SETK 



***** **#**# ••**#* *••***» 

# SETVEC * 
#•#«*•******•#•******••• 

REFER TO 
SETK 
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* SHFTRi * 
#•«*•«•*•«**••••«**•••»• 



* SHFTR1 (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS N0. 0157 
« FAP 0001 
•SHFTRI 0002 

COUNT 140 0003 

LBL SHFTR1 0004 

ENTRY SHFTR1 (NSHFT, I V, L IV, I VSH, IANS3 0005 

* 0006 

* — ABSTRACT 0007 

* 0008 

* TITLE - SHFTR1 0009 
» SHIFT VECTOR ELEMENTS ARITHMETICALLY LEFT OR RIGHT 0010 

* 0011 
» SHFTR1 SHIFTS A FORTRAN VECTOR ARITHMETICALLY T® THE 0012 

* RIGHT OR LEFT A SPECIFIED NUMBER OF PLACES. 0013 

* 0014 

* LANGUAGE -* FAP# SUBROUTINE ( FORTRAN II COMPATIBLE) 0015 

* EQUIPMENT - 704# 70S, OR 7090 (MAIN FRAME ONLY) 0016 
» STORAGE - 70 REGISTERS 0017 

* SPEED - TIME IS LENGTH OF VECTOR TIMES 8 MACHINE CYCLES OR MORE 0018 

* DEPENDING ON NO. OF SHIFTS REQUIRED 0019 
» AUTHOR - S.M. SIMPSON, JUNE, 1962 0020 
» 0021 

* —USAGE 0022 

* 0023 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0024 

* AND FORTRAN SYSTEM ROUTINES - NONE 0025 

* 0026 

* FORTRAN USAGE 0027 

* CALL SHFTR1(NSHFT,IV,LIV,IVSH,IANS) 0028 
» 0029 

* INPUTS 0030 

* _____ 0031 
» IN5MI-I 15 INU. Ut" KLAUti iu iniri \ ikcmicu nSuuLu 3o*» I in uECn. 003* 

» IF NSHFT GRTHAN 0 SHIFT IS TO RIGHT* 0033 

* IF NSHFT LSTHAN 0 SHIFT IS TO LEFT. 0034 
» IF NSHFT = 0 NO SHIFT IS MADE BEFORE IV IS STORED IN IVSH 0035 
« 0036 

* IVU) 1=1.*. LIV IS THE FORTRAN VECTOR. 0037 
» 003d 

* LIV IS IN DECREMENT. 0039 

* LIV MUST EXCEED 0 0040 
» 0041 

* OUTPUTS 0042 

* 0043 

* IVSH(I) 1*1. • .LIV = IV( I)*2**(-<NSHFT)M00 36) 0044 

* IVSHU) ANO IV(1) MAY BE EQUIVALENT. 0045 
» 0046 

* IANS = 0 NORMAL. 0047 

* « +1 OVERFLOW OCCURRED BUT SHIFTING COMPLETED. 0048 

* * -3 ILLEGAL LIV. 0049 
» 0050 

* EXAMPLES 0051 

* 0052 

* 1. INPUTS - NSHFT=6 IVU...2) * OCT 450000000000, 527210000012 0053 

* LIV-2 0054 

* OUTPUTS - IVSH(l«..2) * OCT 400500000000, 401272100000 1ANS*0 0055 
» 0056 
« 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT NSHFT^O 0057 

* OUTPUTS - IVSH(1...2> « OCT 450000000000, 527210000012 1ANS*0 0058 

* 0059 

* 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT NSHFT=-3 0060 

* OUTPUTS - IVSHU...2) = OCT 500000000000, 672100000120 *ANS*1 0061 

* 0062 

* 4. INPUTS - SAME AS EXAMPLE 1. EXCEPT LIV=0 0063 

* OUTPUTS - IVSH IS UNCHANGED IANS=-3 0064 

* 0065 

* 0066 
HTR 0 0067 
HTR 0 0068 
HTR 0 0069 
BCI 1,SHFTR1 0070 

SHFTR1 SXD SHFTRl-4,1 0071 

SXD SHFTRl-3,2 0072 

SXD SHFTRl-2,4 0073 

* 0074 
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» ADDRESS SETTINGS. 




0075 


CLA 


1,4 


AC AINSHFT) ) 


0076 


STA 


GET1 




0077 


CLA 


2,4 


A<A< IV)) 


0078 


ADD 


Kl 




0079 


STA 


CLA 




0080 


CLA 


3,4 


ACAiLIVH 


0081 


STA 


GET3 




0082 


CLA 


4,4 


A(AUVSH)) 


0083 


ADD 


Kl 




0084 


STA 


STO 




0085 


CLA 


5,4 


A(A(IANS>) 


0086 


STA 


PUT5 




0087 


• 






0088 


* GET INPUTS 


NSHFT, LIV, CHECK LIV. 


0089 


GET1 CLA 


• » 


A( NSHFT ) 


0090 


ARS 


18 




0091 


STO 


NSHFT 




0092 


CLS 


K3 




0093 


STO 


IANS 




0094 


GET3 CLA 


** 


A(LIV) 


0095 


ARS 


18 




0096 


STO 


LIV 




0097 


TMI 


LEAVE 




0098 


TZE 


LEAVE 




0099 


STZ 


IANS 




0100 


• 






0101 


» SET SHIFT 


INSTRUCTION. 




0102 


CLA 


NSHFT 




0103 


TMI 


LEFT 




0104 


RIGHT CLA 


KARS 




0105 


STO 


ASHFT 




0106 


TRA 


MOD 




0107 


LEFT CLA 


KALS 




0108 


STO 


ASHFT 




0109 


* 






0110 


* SET MAGNITUDE OF SHIFT 




0111 


MOD CLA 


NSHFT 




0112 


SSP 






0113 


TZE TZE 


SETSH+2 




0114 


SUB 


K36 




0115 


TMI 


SETSH 




0116 


TRA 


TZE 




0117 


SETSH ADD 


K36 




0118 


STA 


ASHFT 




0119 


* 






0120 


* TURN OFF OVERFLOW BEFORE 


LOOP. 


0121 


LXA 


LIV, 1 




0122 


TOV 


CLA 




X)123 


• 






0124 


* LOOP. 






0125 


CLA CLA 


**, 1 


Auvm 


0126 


ASHFT NOP 


** 


ARS ** , OR ALS ** 


0127 


STO STO 


»*#1 


A( IVSH)+1 


0128 


TIX 


CLA, 1,1 




0129 


• 






0130 


» CHECK FOR 


OVERFLOW. 




0131 


TOV 


OVSET 




0132 


TRA 


LEAVE 




0133 


OVSET CLA 


Kl 




0134 


STO 


IANS 




0135 


• 






0136 


• LEAVEt STORING IANS. 




0137 


LEAVE CLA 


IANS 




0138 


ALS 


18 




0139 


PUT5 STO 


«» 


At IANS) 


0140 


LXD 


SHFTRl-4,1 




0141 


LXD 


SHFTRl-3,2 




0142 


LXD 


SHFTRl-2,4 




0143 


TRA 


6,4 




0144 


• 






0145 


* CONSTANTS 






0146 


Kl PZE 


1 




0147 


K3 PZE 


3 




0148 


K36 PZE 


36 




0149 
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KARS ARS 0 0L50 

KALS ALS 0 0151 

» 0152 

» VARIABLES 0153 

NSHFT PZE ♦* 0154 

IANS PZE ♦* -3 f 0, +1 0155 

LIV PZE •» 0156 

END 0157 
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» SHFTR2 * # SHFTR2 » 

••»*•**••**•**»•*••#•*** *•***•••**•»• •*••*• 

» SHFTR2 (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO* 0162 

» FAP 0001 

•SHFTR2 0002 

COUNT 150 0003 

LBL SHFTR2 0004 

ENTRY SHFTR2 (NSHFT, IV, LIV, IVSH, IANS) 0005 

» 0006 

* —ABSTRACT 0007 

* 0008 
» TITLE - SHFTR2 0009 
» SHIFT VECTOR ELEMENTS LOGICALLY LEFT OR RIGHT 0010 

* 0011 
» SHFTR2 SHIFTS A FORTRAN VECTOR LOGICALLY TO THE RIGHT A 0012 

* SPECIFIED NUMBER OF PLACES <0R LEFT IF THE NUMBER OF 0013 
« PLACES IS NEGATIVE), 0014 

* 0015 

* LANGUAGE - FAP# SUBROUTINE (FORTRAN II COMPATIBLE) 0016 
» EQUIPMENT - 704* 709, OR 7090 (MAIN FRAME ONLY) 0017 

* STORAGE - 72 REGISTERS 0018 
» SPEED - TAKES 8»LENGTH OF VECTOR MACHINE CYCLES OR WORE DEPENDING 0019 
» ON NO. OF SHIFTS REQUIRED 0020 
» AUTHOR S.M. SIMPSON AND R.A. WIGGINS 9/28/62 0021 
» 0022 

* —USAGE 0023 

* 0024 
» TRANSFER VECTOR CONTAINS ROUTINES - NONE 0025 
» AND FORTRAN SYSTEM ROUTINES - NONE 0026 

* 0027 

* FORTRAN USAGE 0028 
» CALL SHFTR2 (NSHFT, IV»LIV»IVSH, IANS ) 0029 
» 0030 

* INPUTS 0031 
» 0032 
» NSHFT IS NO. OF PLACES TO SHIFT (TREATED MODULO 36), IN OECR. 0033 

* IF NSHFT GRTHAN 0 SHIFT IS TO RIGHT. 0034 
» IF NSHFT LSTHAN 0 SHIFT IS TO LEFT. 0035 

* IF NSHFT s 0 NO SHIFT IS MADE BEFORE IV IS STORED IN IVSH 0036 

* 0037 
« IVU) 1=1.*. LIV IS THE FORTRAN VECTOR. 0038 

* (NAME NEED NOT 8E FIXED POINT) 0039 

* 0040 
» LIV IS IN DECREMENT. 0041 
« LIV MUST EXCEED 0 0042 

* 0043 
» OUTPUTS 0044 

* 0045 

* IVSH(I) 1=1. ..LIV * IV( I)*2*»(-CNSHFT)M0D 36) 0046 

* IVSH(i) AND IV(1) MAY BE EQUIVALENT. 0047 

* (NAME NEED NOT BE FIXED POINT) 0048 

* 0049 

* IANS = 0 NORMAL. 0050 

* = +1 OVERFLOW OCCURREO BUT SHIFTING COMPLETED. 0051 

* « -3 ILLEGAL LIV. 0052 

* 0053 

* EXAMPLES 0054 

* 0055 

* 1* INPUTS - NSHFT=6 IV ( 1 . ..2 ) =OCT450C000OCOOO, 5272 10000012 LIV* 2 0056 
» OUTPUTS - IVSH( U..2)=OCT004500000000, 005272100000 IANS*0 0057 
» 0058 

* 2. INPUTS - SAME AS EXAMPLE I. EXCEPT NSHFT-0 0059 

* OUTPUTS - IVSHI 1...2)=0CT 450000000000, 52721000012 IANS*0 0060 

* 0061 
» 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT NSHFT=-3 0062 

* OUTPUTS - IVSH( 1...2)=0CT 500000000000,272100000120 IANS*i 0063 
» 0064 
» 4. INPUTS - NSHFT=-3 I V( 1. . .2 )=OCT0007 1422 1216,002 142606060 LIV*2 0065 

* OUTPUTS - IVSH( li..2)=0CT007142212160, 021426060600 IANS^O 0066 
» 0067 

* 5. INPUTS - SAME AS EXAMPLE 4. EXCEPT LIV=0 0068 
» OUTPUTS - IVSHdi.. 2)^0,0 IANS«-3 0069 

* 0070 
HTR 0 0071 
HTR 0 0072 
HTR 0 0073 
BCI 1,SHFTR2 0074 
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SHFTR2 
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* SHFTR2 * 
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IPAbC 21 


SHFTR2 SXD 


SHFTR2-4, 1 




0075 


SXD 


SHFTR£~3,2 




UU f o 


SXD 


SHFTR2-2,4 




UU f i 


* 






UU / o 


» ADORESS SETTINGS* 




UU 1 7 


r i a 


l»4 


A f A f MCUCT 1 1 


0080 


^T A 


GET1 




0081 


CLA 


2,4 


AlAtlVJI 


0082 


a nn 
A uu 


Kl 




UUO D 


^T A 

0>t A 


CLA 




0084 


r i a 

V# L A 


3,4 


AfAfl I \/ t I 


UUo -> 


^TA 
o 1 A 


GET 3 




uuoo 


n a 


4,4 


A(A( IVSHJ) 


UUO f 


ADD 


Kl 




0088 


STA 


STO 




0089 


r t a 


5,4 


A(A( IANS) ) 


uuvu 


CTA 


PUT5 




0091 








0092 


• GFT INPUTS 


NSHFT, L1V, CHECK LIV. 


0093 


GET1 CLA 


** 




0094 


ARS 


18 






STO 


NSHFT 




0096 


CLS 


K3 




Ul/7 1 


STO 


IANS 




0098 


GET3 CLA 


** 


A { L I V ) 


UU77 


ARS 


18 




U i uu 


STO 


LIV 




UX U 1 


TMI 


LEAVE 




U 1 \J£. 


TZE 


LEAVE 




U l U J 


STZ 


IANS 




01 04 


• 








• SET SHIFT 


INSTRUCTION. 




0106 


CLA 






n i 07 


TMI 


left' 




0 1 08 


RIGHT CLA 


KARS 




ni no 

UIU7 


STO 


ASHFT 




U 1 1 u 


TRA 


MOD 




U 1 1 1 


LEFT CLA 


KALS 




U 1 1 C 


STO 


ASHFT 




ni i l 
Ul I J 


* 






ftl 1 A 

UliH 


* SET MAGNITUDE OF SHIFT ( 


FX IT T F 7 Fftfl 1 - 


UU -> 


MOD CLA 


NSHFT 




U 1 1 O 


SSP 






m i 7 


TZE TZE 


SETSH+2 




m i pi 

Ul 1 0 


SUB 


K36 




m 1 Q 


TMI 


SETSH 






TRA 


TZE 




U 1 c. 1 


SETSH ADD 


K36 




\J Lc.C 


STA 


ASHFT 






• 








« TURN OFF OVERFLOW BEFORE 


LOOP. 


ill oc 
Ul Z !> 


LXA 


LIV,1 




0126 


LDQ 


=0 




m 97 

Ult i 


TOV 


CLA 




U 1 £o 


* 








* LOOP. 






U 1 ->U 


CLA CAL 


**♦ 1 


A( IV) + l 


mil 


ASHFT NOP 


** 


ARS ** , OR ALS *» 




STO SLW 


»«, 1 


A< IVSH)+1 


0133 


TIX 


CLA, 1,1 




A1 1A 
Ul JH 


• 






0135 


• CHECK FOR 


OVERFLOW. 




U 1 JO 


TOV 


OVSET 




Ul j f 


TRA 


LEAVE 




ni ao 
Ul 3o 


OVSET CLA 


Kl 




01 39 


STO 


IANS 




0140 


• 






0141 


» LEAVE* STORING IANS. 




0142 


LEAVE CLA 


IANS 




0143 


ALS 


18 




0144 


PUT5 STO 


• # 


A( IANS) 


0145 


LXD 


SHFTR2-4, I 




0146 


LXD 


SHFTR2-3,2 




0147 


LXD 


SHFTR2~2,4 




0148 



••*•*••••*•••**»#»••**«« PROGRAM LISTINGS **#*#***»###**«***#«*♦»* 

♦ SHFTR2 » * SHFTR2 » 
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TRA 6,4 0149 

• 0150 

* CONSTANTS 0151 

Kl PZE 1 0152 

K3 PZE 3 0153 

K36 PZE 36 0154 

KARS ARS 0 0155 

KALS ALS 0 0156 

* 0157 

• VARIABLES 0158 
NSHFT PZE ** 0159 

IANS PZE ** -3, 0, +1 0160 

LIV PZE »* 0161 

END 0162 
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#•***«***♦•*«••••*#«»»*» 

# SHUFFL » 



* SHUFFL (SUBROUTINE) 9/8/64 LAST CARD IS DECK IS NO* 0124 

* LABEL 0001 
C SHUFFL 0002 

SUBROUTINE SHUFFL < IT PRO, NITEMS, ISPACE, IXSHUF J 0003 

C 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - SHUFFL 0008 

C SHUFFL A LIST OF INTEGERS FROM i TO N 0009 

C 0010 

C SHUFFL IS GIVEN *A NUMBER N, FROM WHICH IT INFERS THE 0011 

C SET OF INTEGERS 1,2,*..,N. IT THEN PRODUCES AN OUTPUT 0012 

C VECTOR OF LENGTH N WHOSE ELEMENTS ARE THE INTEGERS FROM 0013 

C THIS SET BUT RANDOMLY SCRAMBLED. REPEATED CALfiS YIELD 0014 

C INDEPENDENT SHUFFLINGS. 0015 

C 0016 

C THE TECHNIQUE UTILIZES THE RAND RANDOM DIGITS TAPE 0017 

C i ACCESS THRU SUBROUTINE GETRD1) AS FOLLOWS- EACH 0018 

C ORIGINAL INTEGER IS ASSIGNED A UNIQUE EQUALLY LIKELY 0019 

C RANDOM NUMBER IN THE RANGE 0 TO 99,999* AN INDEX BY SIZE 0020 

C OF THESE NUMBERS IS THE DESIRED LIST OF SHUFFLED NUMBERS- 0021 

C 0022 

C A SPACE VECTOR OF LENGTH N IS REQUIRED FOR SCRATCH. 0023 

C 0024 

C LANGUAGE - FORTRAN- I I SUBROUTINE 0025 

C EQUIPMENT - 709,7090,7094 I MAIN FRAME PLUS ONE TAPE UNIT) 0026 

C STORAGE - 101 REGISTERS 0027 

C SPEED - TAKES ON THE ORDER OF .004«N SECONDS ON THE 7094,* 0028 

C AUTHOR - S.M. SIMPSON, FEBRUARY, 1964 0029 

C 0030 

C 0031 

c usacii onio 

c — — 

C TRANSFER VECTOR CONTAINS ROUTINES - GETRD1 , SEARCH, S IZEUP 0034 

C AND FORTRAM SYSTEM ROUTINES - (NOT ANY) 0035 

C 0036 

C 0037 

C FORTRAN USAGE 0038 

C CALL SHUFFLIITPRD,NITEMS, ISPACE, IXSHUF) 0039 

C 0040 

C 0041 

C INPUTS 0042 

C 0043 

C ITPRD IS THE LOGICAL TAPE NO. OF THE RAND RANDOM DIGITS TAPE. 0044 

C SHUFFL DOES NOT POSITION ITPRD BEFORE OR AFTER CALLING 0045 

C SUBROUTINE GETRD1. 0046 

C 0047 

C NITEMS IS THE GIVEN NO. OF ITEMS (CALLED N IN ABSTRACT ) • 0048 

C 0049 

C ISPACE(I) 1*1. • .NITEMS MUST BE AVAILABLE FOR SCRATCH. 0050 

C 0051 

C 0052 

C OUTPUTS STRAIGHT RETURN WITH NO OUTPUTS IF NITEMS-0 OR LESS* 0053 

C 0054 

C IXSHUFU) 1 = 1.. .NITEMS IS A SHUFFLED LIST OF THE INTEGERS 0055 

C 1. ..NITEMS. 0056 

C 0057 

C 0058 

C EXAMPLES 0059 

C 0060 

C 1. INPUTS - ASSUME THE FIRST TWO RANDOM DIGITS CARDS CONTABN DIGITS 0061 

C AS FOLLOW 0062 

C 10097325337652013586346735487680959091173929274945 0063 

C 37542048056489474296248052403720636104020082291665 0064 

C AND THAT THESE ARE ON LOGICAL 9, WHICH IS REWOUND. 0065 

C 0066 

C USAGES - CALL SHUFFL ( 9, 7, 1 SPACE, I XSHF 1 ) 0067 

C CALL SHUFFL(9, 10, ISPACE, IXSHF2) 0068 

C 0069 

C OUTPUTS - IXSHF111...7) = 1,4,2,5,6,3,7 0070 

C IXSHF2U...10) * 5,1,10,9,8,4,2,6,7,3 0071 

C 0072 

C 0073 
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«**#*»***«•••**********• 

# SHUFFL * 
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C PROGRAM FOLLOWS BELOW 

C 

C 

C DUMMY DIMENSIONS 
C 

DIMENSION ISPACE(2),IXSHUF(2) 

C 

C TRUE DIMENSIONS 
C 

DIMENSION IRD(5) 

C 

C (NDIGS COULD BE CUT BACK TO 3 OR 4 TO SAVE DIGITS) 
C 

NDIGS=5 

C 

C CHECK OUT 
C 

IF (NITEMS) 9999,9999,10 
10 CONTINUE 

C 

C FIRST SET UP THE ISPACE VECTOR WITH RANDOM NUMBERS 
C 

DO 100 IXSP=1, NITEMS 

C 

C ACQUIRE THE NEXT GROUP OF DIGITS (IGNORE IANS) INTO IRD( 1. . JNDIGS ) 
C 

40 CALL GETRD11 ITPRD, NDIGS, IRD, IANS) 

C 

C CONVERT TO INTEGER IN RANGE 0 TO 10EXP( NDIGS)-1 
C 

NUMB=0 

DO 50 IXD=i, NDIGS 
50 NUMB»10*NUMB+IRD(IXD) 

C 

C RETURN TO GETRD1 STATEMENT IF THIS NUMBER HAS OCCURRED ALREADY 

C (SEARCH WORKS FOR LNOW=0). 

C 

LN0W=IXSP-1 

CALL SEARCH! LNOWt I SPACE, NUMB, INDEX) 
IF (INDEX) 70,70,40 

C 

C STORE THE NEW NUMBER 
C 

70 ISPACE(IXSP)=NUMB 
100 CONTINUE 

C 

C NOW MAKE A SIZE INDEX OF ISPACE INTO IXSHUF AND EXIT. 
C 

CALL S I ZEUP II SPACE, NITEMS, IXSHUF) 
9999 RETURN 
END 



0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 



»»*****•*••**»••*•**••*» PROGRAM LISTINGS #**#*»**»##4#»*«»#***##* 

* SIFT * ♦ SIFT « 

•»*»*•««*••*•»*•***•«*•» **»*•»*••»*«*#•«*•****•» 



» SIFT (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO* 0117 

• FAP 0001 
•SIFT 0002 

COUNT 150 0003 

LBL SIFT 0004 

ENTRY SIFT (X, MESH, LXSFTD, XSFTD) 0005 

« 0006 

* 0007 
» — , — ABSTRACT 0008 

* 0009 

* TITLE - SIFT 0010 

♦ FORM A VECTOR BY SIFTING ANOTHER AT EVEN INCREMENTS 0011 

* 0012 

• SIFT FORMS A VECTOR 0013 

• 0014 

* XSFTD(I) = X(i+( I-1)»MESH) 1*1. ..LXSFTD 0015 

* 0016 

• GIVEN THE INPUT VECTOR X(U..) AND THE VALUES MESH 0017 
» AND LXSFTD. OUTPUT VECTOR MAY REPLACE INPUT VECTOR. 0018 

* 0019 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN-I I COMPATIBLE) 0020 

• EQUIPMENT - 709,7090,7094 (MAIN FRAME ONLY) 0021 

• STORAGE - 30 REGISTERS 0022 

* SPEED - 43 + 10*LXSFTD MACHINE CYCLES ON THE 7090 0023 

* AUTHOR - S.M. SIMPSON, JUNE 1964 0024 

* 0025 

• 0026 

• USAGE 0027 

• 0028 

* TRANSFER VECTOR CONTAINS ROUTINES - NOT ANY 0029 

• AND FORTRAN SYSTEM ROUTINES - NOT ANY 0030 

♦ 0031 

• ruKiKAiM uSaGe 0032 
» CALL SIFTU, MESH, LXSFTD, XSFTD) 0033 
» 0034 

* 0035 
» INPUTS 0036 

• 0037 

• XU) 1*1,2,*.. IS A FIXED OR FLOATING VECTOR. 0038 
» 0039 
» MESH SHOULD NOT BE LESS THAN ZERO. 0040 

* 0041 
» LXSFTD SHOULD EXCEED ZERO. 0042 
» 0043 

* 0044 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUT FOR ILLEGAL MESH OR 0045 
» LXSFTD. 0046 

* 0047 
» XSFTD(I) 1=1. ». LXSFTD IS DESCRIBED IN ABSTRACT. 0048 
« EQUIVALENCE (X, XSFTD) IS OK. 0049 

* 0050 

* 0051 

• EXAMPLES 0052 
» 0053 

♦ 1. INPUTS - X(1...10> * l.,2.,3.,..»,10. XS5U) » XS6I1 ) * -9. 0054 

• USAGE - CALL S IFT { X ,0, 3, XS 1 ) 0055 
» CALL SIFT(X,1,3,XS2) 0056 
» CALL SIFT(X, 3,3, XS3) 0057 

• CALL SIFT<X,3,1,XS4) 0058 

* CALL SIFT(X,-1,3,XS5) 0059 

* CALL SIFTCX,1,0,XS6) 0060 

• CALL SIFT(X,5,2,X) 0061 

• 0062 

• OUTPUTS - XSK1.J.3) * l.,l.,i. XS2<1...3) = l.,2.,3. 0063 

* XS3(1.W.3) = l.,4.,7. XS4(1) » 1. XS5U) * XS6tl) * -9. 0064 
» XU...2) = l.,6. 0065 

• 0066 

* 0067 

* PROGRAM FOLLOWS BELOW 0068 

• 0069 
» NO TRANSFER VECTOR 0070 
« 0071 

HTR XR1 0072 

HTR XR4 0073 
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BCI 


1,SIFT 




0074 


• 








0075 


* ONLY 


ENTRY. 


SIFT(X, MESH, 


LXSFTD, XSFTD) 


0076 


• 








0077 


SIFT 


SXD 


SIFT-3,1 




0078 




SXO 


SIFT-2,4 




0079 


* 








0080 


* SET , 


ADDRESSES, CHECK MESH 


GRTHN 38 ZERO, LXSFTD GRTHN=* 1 • 


0081 


• 








0082 




CLA 


1,4 


A(X) 


0083 




ADD 


Kl 


A(X )+l 


0084 




STA 


CLA 




0085 




CLA 


4,4 


A( XSFTD) 


0086 




ADD 


Kl 


A( XSFTD)+1 


0087 




STA 


STO 




0088 




CLA* 


2,4 


MESH 


0089 




TZE 


STD 




0090 




TMI 


LEAVE 




0091 


STO 


STD 


TXI 




0092 




CLA* 


3,4 


LXSFTD 


0093 




TMI 


LEAVE 




0094 




PDX 


0,1 




0095 




TXL 


LEAVE, 1,0 




0096 




STD 


TXL 




0097 


• 








0098 


* LOOP 


WITH XR1, XR4 STARTING 


AT 1 


0099 


* 








0100 




AXT 


1,5 




0101 


CLA 


CLA 


**,4 


** = A(X)+1 


0102 


STO 


STO 


**, 1 


** » A(XSFTD)*1 


0103 


TXI 


TXI 


*+l,4,#* 


** = MESH 


0104 




TXI 


•+1,1.1 




0105 


TXL 


TXL 


CLA,!,** 


** « LXSFTD 


0106 


• 








0107 


* EXIT 








0108 


• 








0109 


LEAVE 


LXD 


SIFT-3,1 




0110 




LXD 


SIFT-2,4 




0111 




TRA 


5,4 




0112 


» 








0113 


* CONSTANT 






0114 


» 








0115 


Kl 


PZE 
END 


1 




0116 
0117 
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» SIMEQ (SUBROUTINE) 9/9/64 LAST CARO IN DECK IS NO. 0641 

* FAP 0001 
♦SIMEQ 0002 

COUNT 550 0003 

LBL SIMEQ 0004 

ENTRY SIMEQ IN, LN, LM, A, B , D, E, ERR ) 0005 

ENTRY OETRM <N, LN, A, D, ERR ) 0006 

* 0007 
» ABSTRACT 0008 

* 0009 

* TITLE - SIMEQ WITH SECONDARY ENTRY POINT OETRM 0010 

* SOLUTION OF SIMULTANEOUS EQUATIONS AND DETERMINANT EVALUATION 0011 

* 0012 

* SIMEQ SOLVES THE MATRIX EQUATION 0013 

* 0014 
» AX=B 0015 
» 0016 
» WHERE A HAS LN ROWS AND LN COLUMNS 0017 

* B HAS LN ROWS AND LM COLUMNS 0018 

* X HAS LN ROWS AND LM COLUMNS 0019 

* 0020 

* THE SOLUTION MATRIX, X, IS STORED IN A. 0021 
» THE SOLUTION OF THE MATRIX EQUATION IS ACOMPL ISHED BY 0022 

* UPPER TR I ANGULAR I Z AT ION OF THE A MATRIX USING A MAXIMUM 0023 
» PIVOT FOR EACH REDUCTION STEP. A SCALED VERSION OF THE 0024 
» DETERMINANT IS COMPUTED AT THE SAME TIME. 0025 

* 0026 
» DETRM COMPUTES THE DETERMINANT OF A. THE DETRM ENTRY 0027 
« POINT CAUSES ONLY THE TR I ANGULAR I Z AT ION PROCESS OF SIMEQ 0028 
» TO BE OPERATIVE. THE COMPUTATION IS PERFORMED BY FORMING 0029 

* PRODUCTS OF SUCCESSIVE PIVOTS WITH PROPER SIGN ADJUSTMENT 0030 

* TO COMPENSATE FOR THE ROW AND COLUMN INTERCHANGES. 0, THE 0031 

UC I cRril INAINI V ALUfc 15 I MU5 0032 

» 0033 

» D*(..«MUD)A(l,l))AI2,2)). fc .)A(LN,LN) 0034 

» 0035 

* WHERE THE A(I,I) ARE THE PIVOTS. S IS SET INITIALLY BY THE 0036 
» CALLING PROGRAM SO THAT A SCALED VERSION OF THE 0037 

* DETERMINANT MAY BE OBTAINED. S SHOULD BE SET TO l; IF NO 0038 

* SCALING IS DESIRED. 0039 
» 0040 

* IF THE MATRIX IS SINGULAR THE VALUE OF THE DETERMINANT 0041 

* WHICH IS RETURNED IS ZERO. 0042 

* 0043 
» NOTE- SIMEQ DESTROYS BOTH THE A AND B MATRICES. 0044 

* DETRM DESTROYS THE A MATRIX. 0045 

* 0046 

* 0047 

* LANGUAGE -< FAP 0048 

* EQUIPMENT - 709/7090/7094 (MAIN FRAME ONLY) 0049 

* STORAGE - 441 REGISTERS 0050 

* SPEED - SIMEQ - 0051 

* 13«LN**3 + 20*LM«LN*«2 ♦ 49*LN»»2 + 51*LH*LN 0052 

* + 158*LN ♦ 100 MACHINE CYCLES Oil THE 70904 0053 

* DETRM - 0054 

* ll*LN»*3 ♦ 39«LN««2 ♦ 126»LN ♦ 28 0055 

* MACHINE CYCLES ON THE 7090. 0056 

* AUTHOR - XSIMEQ AND XDETRM WERE ORIGINALLY WRITTEN IN FORTRAN FOR 0057 

* THE 704 BY J.T. OLSZTYN I SHARE DISTRIBUTIONS 351 AND 3641* 0058 

* THEY HAVE BEEN REWRITTEN IN FAP WITH SOME CORRECTIONS AND 0059 
» SPEED IMPROVEMENTS BY ARCADIO M. NIELL OF THE COMPUTATION 0060 
» CENTER AT M.I.T. ADDITIONAL CORRECTIONS TO TAKf INTO 0061 

* ACCOUNT CHANGES IN FORTRAN HAVE BEEN ADDED 8Y THE 0062 

* COMPUTATION CENTER STAFF. SIMEQ, AND DETRM ARE THE 0063 

* RESULT OF A CHANGE IN DEFINITION OF XSIMEQ AND XDETRM 0064 

* MADE BY R. A. WIGGINS. 0065 

* 0066 

* —USAGE 0067 

« 0068 

* TRANSFER VECTOR CONTAINS ROUTINES- NONE 0069 

* AND FORTRAN SYSTEM ROUTINES- NONE 0070 

* 0071 
» FORTRAN USAGE 0072 

* CALL SIMEQ I N , LN, LM, A , B, D, E, ERR ) 0073 
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CALL OETRM (NtLKI* A,D*ERR) 



AH,J) 



LN 



BU*J) 



LM 

0 



EU) 



* OUTPUTS 
♦ 

* AM, J) 



D 

ERR 



* EXAMPLES 



1=1. ..LN, J=1...LN IS NORMALIZED FLOATING POINT VECTOR 

CONTAINING THE ELEMENTS OF THE A MATRIX. 
J REFERS TO THE COLUMN INDEX, I TO THE ROW INDIXi 
IS DESTROYED BY THE SUBROUTINE. 

1 LSTHN= LN LSTHN= N 
IS FORTRAN II INTEGER 

IS THE LARGEST VALUE WHICH I (OF A( 1,J)> MAY TAKE ON. 
IF At I, J) IS DIMENSIONED AS A ONE-DIMENSIONEB VECTOR 

WITH THE ROWS STACKED TOGETHER, THEN N*LN. 
IF Ail, J) IS DIMENSIONED AS A TWO DIMENSIONAL VECTOR, 
THEN N IS THE VALUE DIMENSIONED FOR I USEE ALSO Bl 
I.E. DIMENSION Al N,N ) 
IS FORTRAN II INTEGER 

1=1.. .LN, J=1...LM IS NORMALIZED FLOATING POINT VECTOR 

CONTAINING THE ELEMENTS OF THE B MATRIX, 
J REFERS TO THE COLUMN INDEX, I TO THE ROW INDEX. 
IS DESTROYED BY THE SUBROUTINE 

IF B IS DIMENSIONED AS A TWO-DIMENSIONED VECTOR, THEN 
THE FOLLOWING LIMITS HOLD ISEE ALSO N) 
DIMENSION A(N,N) * BCN,Nl) 
I LSTHN= LN LSTHN- N 
LM LSTHN* Nl LSTHN* N 
LM MAY BE GRTHN= LN 

IS FORTRAN II INTEGER 

IS A FLOATING POINT VARIABLE WHICH SERVES AS A SCALE 
BY WWICH THE VALUE OF THE DETERMINANT OF A IS 
MULTIPLIED. 

CAUTION - THIS IS ALSO AN OUTPUT VARIABLE. 

1=1. ..LN IS ERASABLE COMPUTATION SPACE. 
NEED NET HAVE FLOATING POINT NAME. 



1=1.. .LN, J=1...LM IS THE FLOATING POINT VECTOR 

CONTAINING THE ELEMENTS OF THE X MATRIX. 
J REFERS TO THE COLUMN INDEX* I TO THE ROW INDfXi 

IS THE SCALED VERSION OF THE DETERMINANT OF A. 

=0. IF SOLUTION WAS SUCCESSFUL 

=1. IF UNDERFLOW OR OVERFLOW OCCURRED. 

=2. IF MATRIX A IS SINGULAR. 



SIMEQ EXAMPLES 



BU...2) = 1. 



0. 



» 1. INPUTS - Ail, 1. J. 2) = 2., 3. 

♦ A<2,1.«.2) = 1., 2. 

* LN=*2 N=2 LM=1 0=1. 
DIMENSION A(2,2), B( 2) , EI2) 
CALL SIMEQ CN,LN,LM, A,B, D, £,ERR) 

A(l...2,l) = 2.000, -I. 000 D=l. ERR=0. 



USAGE 
OUTPUTS 
INPUTS 



B<1,1...2) = 1., 
B(2,1...2) = 0., 



0. 
1. 



* 2. INPUTS - A(l, 1.^.2) = 2., 1. 

* A(2,1.«U2) = 1., 2. 

* LN=2 N=2 LM=2 D=l. 

* USAGE - DIMENSION A(2,2), B(2,2), E<2) 

« CALL SIMEQ < N, LN, LM, A, B, D, E, ERR ) 

* OUTPUTS - A(l,1...2) = .667, -.333 D=3. ERR=0. 

* A(2,l.*.2) =-.333, .667 
* 

* 3. INPUTS - A(l,l.*.2) = 2., 1. B(l,l.*.3) = 1., 0., 1. 

* A(2,1.^.2) = 1., 2. B(2,1...3) = 0., 1., 1. 

* LN=2 N=3 LM=3 D=l. 

* USAGE - DIMENSION A13,3), B<3,3>, E(2) 

* OUTPUTS - Aii,1...3) = .667, -.333, .333 D=3. ERR=0. 



0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
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* 






A(2,1...3) 


333, .667, .333 


0149 












0150 




I NPUTS 




SAME AS EXAMPLE I. EXCEPT D=2. 


0151 




OUTPUTS 




A(1...2,l) 


= 2.000, -I. 000 D=2. ERR»C. 


n i a o 
U Lj c. 












0153 




INPUTS 




A<1...4) = 


2«, 1., U, 2. B(1...2) - 1., 0. 


0 1 54 


* 






LN*2 N=2 


LM=1 0=1. 


0155 




USAGE 




DIMENSION A(4), BI2), E(2) 


0156 




OUTPUTS 




A(i...2> -= 


.667, -.333 0=3. ERR=0. 


0157 












0158 


» O . 


INPUTS 




AU...4) = 


1., 0«, 0«, 0* B(1...2) = 1., 0. 


0159 








LN»2 N=2 


LM=1 D=l. 


0160 


* 


OUTPUTS 




D=0. ERR- 


2. 


n i a i 
uioi 












0162 












0163 




DETRM EXAMPLES 




0164 












UIOD 




INPUTS 




A( i.*2,l>=2 


.,1. LN*2 N=5 D*l. 


ni a a 








A(l..2,2)*l 


.*2. 


0167 


• 


OUTPUTS 




ERR=0. D= 


3. 


0168 


* 










0169 


* 2. 


INPUTS 




SAME AS EXAMPLE 1. EXCEPT D*2. 


0170 


* 


OUTPUTS 




ERR=0- D= 


6. 


Ul ( 1 


• 










U 1 / Z 


* 3. 


INPUTS 




SAME AS EXAMPLE 1. EXCEPT LN = 3 


0173 


» 






A(i.*3,3) * 


0., A(3,1..3)«0. 


Ul IH 


• 


OUTPUTS 




ERR-2. D= 


0. 


Ul / D 


• 










0176 


* 










0177 


» PROGRAM FOLLOWS BELOW 




0178 


* 










0179 




P ZE 




0 




0180 




UK, I 




if jiritv 








REM 








0182 




REM 




LOCATE PIVOT AND RECORD I AND J 


0183 


Tl 


LXD 




AKK,1 


INITIALIZE ELEMENT LOCATION INDEX 


0184 




SXD 




AKQ , 1 




0185 




LXD 




K,2 


INITIALIZE ROW INDEX 


0186 




LXD 




K,4 


INITIALIZE COLUMN INDEX 


018 7 




SXD 




1,2 


INITIALIZE MAXIMUM PIVOT ROW 


0188 




SXD 




J»4 


INITIALIZE MAXIMUM PIVOT COLUMN 


0189 


T7 


PXD 




0,0 




0190 


T8 


ADM 




0,1 


AC CONTAINS MAGNITUDE CURRENT MAXIMUM 


0191 




TXI 




TIO, 1,1 


NEXT ELEMENT 


0192 


TIO 


TXI 




Til, 2,1 


NEXT ROW 


0193 


Til 


TXH 




T17,2,LN 


TRANSFER IF LAST ROW TESTED 


0 1 94 


T12 


SBM 




0,1 


TEST CURRENT ELEMENT 


0195 




TPL 




T8 


CURRENT MAXIMUM PIVOT HOLDS 


0196 




SXD 




It2 


CHANGE MAXIMUM PIVOT 


0197 




SXD 




Jt4 




0198 




TRA 




T7 




0199 


T17 


LXD 




AKQ, 1 


KTH ELEMENT, CURRENT COLUMN 


0200 


T18 


TXI 




T19,1,N 




0201 


T19 


SXD 




AKQ, 1 


KTH ELEMENT, NEXT COLUMN 


0202 




LXD 




K,2 


KTH ROW 


0203 




TXI 




T20,4,i 


NEXT COLUMN 


0204 


T20 


TXL 




T12,4,LN 


EXIT IF LAST COLUMN TESTED 


0205 




REM 








0206 




REM 




INTERCHANGE 


ROWS IF NECESSARY 


0207 




REM 








0208 


T21 


CLA 




I 




0209 




SUB 




K 




02 1 0 




TZE 




T55 


NO ROW INTERCHANGE 


02 1 1 




ADD 




AKK 




0212 




PDX 




0,2 


INITIALIZE ITH ROW INDEX 


\Jc. l 3 




LXD 




AKK, 1 


INITIALIZE KTH ROW INDEX 


0214 




LXD 




K,4 


INITIALIZE COLUMN INDEX 


0215 


T28 


CLS 


t 


D 


CHANGE SIGN OF 


0216 


T29 


STO 


t 


D 


DETERMINANT 


0217 


T30 


LDQ 




0,1 


INTERCHANGE 


0218 




CLA 




0,2 


KTH AND ITH 


0219 




STO 




0,1 


ROWS OF 


0220 




STQ 




0,2 


MATRIX A 


0221 


T34 


TXI 




T35,1,N 


NEXT ELEMENT , KTH ROW 


0222 


T35 


TXI 




T36,2,N 


NEXT ELEMENT, ITH ROW 


0223 
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T36 


TXI 




T37,4,l 


NEXT COLUMN 




0224 


T37 


TXL 




T30,4,LN 






0225 


T38 


NOP 






TRANSFER TO T55 FOR XDETRM 




0226 




CLA 




KM1 






0227 




ADD 




B 






0228 




PDX 




0,1 


INITIALIZE KTH ROW INDEX 




0229 




SUB 




K 






0230 




ADD 




I 






0231 




POX 




0,2 


INITIALIZE ITH ROW INDEX 




0232 




LXD 




=0X000000,4 


INITIALIZE COLUMN INDEX 




0233 


T46 


LOQ 




0,1 


INTERCHANGE 




0234 




CLA 




0,2 


KTH AND ITH 




0235 




sro 




0,1 


ROWS OF 




0236 




STQ 




0,2 


MATRIX B 




0237 


T50 


TXI 




T5l,l,N 


NEXT ELEMENT, KTH ROW 




0238 


T5i 


TXI 




T52,2,N 


NEXT ELEMENT, ITH ROW 




0239 


T52 


TXI 




T53,4,l 


NEXT COLUMN 




0240 


T53 


TXL 




T46,4,LM 


EXIT IF LAST COLUMN PROCESSED 




0241 




REM 










0242 




REM 




INTERCHANGE 


COLUMNS IF NECESSARY 




0243 




REM 










0244 


T55 


CLA 




J 






0245 




SUB 




K 






0246 




TZE 




T85 


NO COLUMN INTERCHANGE 




0247 




ADD 




KM1 






0248 




LRS 




35 






0249 




MPY 




N 






0250 




ALS 




17 






0251 




ADD 




A 






0252 




PDX 




0,1 


INITIALIZE JTH COLUMN INDEX 




0253 




CLA 




KM1N 






0254 




ADD 




A 






0255 




PDX 




0,2 


INITIALIZE KTH COLUMN INDEX 




0256 




LXD 




LN,4 


INITIALIZE COMPLEMENTARY ROW 


INDEX 


0257 


T68 


CLS 


* 


D 


CHANGE SIGN OF 




0258 


T69 


STO 


t 


D 


DETERMINANT 




0259 


T70 


LDQ 




0,1 


INTERCHANGE 




0260 




CLA 




0,2 


KTH AND JTH 




0261 




STO 




0,1 


COLUMNS OF 




0262 




STQ 




0,2 


MATRIX A 




0263 




TXI 




T75,l,l 


NEXT ELEMENT, JTH COLUMN 




0264 


T75 


TXI 




T76,2,l 


NEXT ELEMENT, KTH COLUMN 




0265 


T76 


TIX 




T70,4,i 






0266 


T77 


NOP 






TRANSFER TO T85 FOR XDETRM 




0267 




LXD 




J,l 






0268 




LXD 




K,2 






0269 


T80 


CLA 


,1 


£ + 1,1 


INTERCHANGE 




0270 


T81 


LDQ 


,2 


E+1,2 


JTH AND KTH 




0271 


T82 


STO 


,2 


E + 1,2 


ELEMENTS OF 




0272 


T83 


STQ 


,1 


E + 1,1 


ARRAY E 




0273 




REM 










0274 




REM 




COMPUTE DETERMINANT 




0275 




REM 










0276 


T85 


LXD 




AKK, 1 






0277 




CLA 




0,1 


PIVOT ELEMENT 




0278 




TZE 




T251 


MATRIX A SINGULAR 




0279 




LRS 




35 






0280 


T89 


FMP 


t 


D 






0281 


T90 


STO 


, 


D 






0282 




REM 










0283 




REM 




ROW REDUCTION 




0284 




REM 










0285 




LXD 




KP1,1 






0286 




SXD 




El,l 


INITIALIZE ROW TO BE REDUCED 




0287 




LXD 




AKK , 1 






0288 




SXD 




E2,l 






0289 




CLA 




KM1 






0290 




ADD 




B 






0291 




STD 




E3 






0292 


T99 


LXD 




E3,l 






0293 




TXI 




T101,l,l 






0294 


T101 


SXD 




E3,l 


FIRST ELEMENT, CURRENT ROW, MATRIX B 


0295 




LXD 




E2,l 






0296 




TXI 




T104,l,l 






0297 


T104 


SXD 




E2,l 


LEADING ELEMENT, CURRENT ROW, 


MATRIX A 


0298 
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LXO 


AKK, 2 




0299 




LXD 


KPl ,4 


INITIALIZE COLUMN INDEX 


0300 




CLA 


0,1 




0301 




TZE 


Tl 36 


ROW NEEDS NO REDUCTION 


0302 




FOP 


0,2 




0303 




STO 


G 




0304 


Till 


TXI 


Tll2»l,N 




0305 


TH2 


TXI 


T 1 1 3 , 2 , N 




0306 


T113 


LDQ 


G 




0307 




FMP 


0,2 




0308 




CHS 






0309 




FAD 


0,1 




0310 




STO 


0,1 


ELEMENT REDUCED 


0311 


T118 


TXI 


T119,1^N 


NEXT ELEMENT, CURRENT ROW 


0312 


T119 


TXI 


T120#2,(N 


NEXT ELEMENT, KTH ROW 


0313 


T120 


TXI 


T121,4#l 


NEXT COLUMN 


0314 


T121 


TXL 


T113»4,LN 




0315 


T122 


NOP 




TRANSFER TO T136 FOR XDETRM 


0316 




LXD 


E3 |1 


BEGIN REDUCTION OF MATRIX B 


0317 




CLA 


KM1 




0318 




ADD 


B 




0319 




PDX 


0,2 




0320 




LXD 


LM,4 




0321 


T128 


LDQ 


0,2 




0322 




FMP 


G 




0323 




CHS 






0324 




FAD 


0,1 




0325 




STO 


0,1 


ELEMENT REDUCED 


0326 


T133 


TXI 


T134, I ,N 


NEXT ELEMENT, CURRENT ROW 


0327 


T134 


TXI 


T135»2 #N 


NEXT ELEMENT, KTH ROW 


0328 


T135 


TIX 


T128#4, 1 




0329 


T136 


LXD 


El , 1 




0330 




TXI 


i 136, i * 1 






T138 


SXD 


El 41 


NEXT ROW TO BE REDUCED 


0332 


T139 


TXL 


T99 , 1 ,LN 




0333 




LXD 


KP1 , 1 




0334 




TXI 


T142, 1,1 




0335 


T142 


TXH 


T156*l ,LN 


REDUCTION COMPLETE 


0336 




SXD 


KPt , 1 


K + l 


0337 




TIX 


T145, 1, 1 




0338 


T145 


SXD 


K, 1 


K 


0339 




TIX 


T147, 1,1 




0340 


T147 


SXD 


KM1 , 1 


K-l 


0341 




CLA 


KM1 N 




0342 




ADD 


N 




0343 




STO 


KM1N 


( K-l )N 


0344 




CLA 


AKK 




0345 




ADD 


N 




0346 




ADD 


=01000000 




0347 




STO 


AKK 




0348 




TRA 


Tl 


BEGIN NEW STAGE 


0349 


T156 


CLA 


AKK 




0350 




ADD 


N 




0351 




ADD 


=01000000 




0352 




PDX 


0,1 




0353 




CLA 


0,1 


LAST PIVOT 


0354 




TZE 


T251 


MATRIX A SINGULAR 


0355 




LRS 


35 




0356 


T163 


FMP 


, D 


FINAL VALUE OF 


C357 


T164 


STO 


, D 


DETERMINANT 


0358 


T165 


NOP 
REM 




THRU FOR XDETRM 


0359 
0360 




REM 


BACK SUBSTITUTION 


0361 




REM 






0362 




SXD 


AKK , 1 




0363 




CLA 


LN 




0364 




SUB 


=01000000 




0365 




ADD 


B 




0366 




STD 


E3 




0367 




LXD 


LM,1 




0368 




SXD 


EW1 




0369 


T174 


LXD 


LN, 1 




0370 




SXD 


E4,l 




0371 




LXD 


AKK, I 




0372 




SXD 


E2,l 




0373 
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LXD 


E3,2 




0374 




CLA 


0,2 




0375 




FOP 


oa 




0376 




STQ 


0,2 




0377 


T182 


LXD 


E2,l 




0378 




TXI 


T184,l,-i 




0379 


T184 


SXO 


E2, 1 


LAST ELEMENT, CURRENT R0W # MATRIX A 


0380 




STZ 


G 




0381 




LXO 


E4#4 




0382 




TNX 


T204,4,l 




0383 




SXD 


E4#4 


ROW TO BE PROCESSED 


0384 




LXD 


E3,2 




0385 


T191 


LDQ 


0,1 




0386 




FMP 


0,2 




0387 




FAD 


G 




0388 




STO 


G 




0389 


T195 


TXI 


T196,1, -N 




0390 


T196 


TXI 


T197,2,-1 




0391 


T197 


TXI 


T198»4,i 




0392 


T198 


TXL 


T19i,4,LN-l 




0393 




CLA 


0,2 




0394 




FSB 


G 




0395 




FDP 


0,1 




0396 




STQ 


0,2 


VALUE OF UNKNOWN 


0397 




TRA 


T182 




0398 


T204 


LXD 


E3,2 




0399 


T205 


TXI 


T206,2,N 




0400 


T206 


SXD 


E3,2 


LAST ROW, NEXT COLUMN, MATRIX B 


0401 




LXD 


El,2 




0402 




TNX 


T212,2,l 




0403 


T209 


SXD 


El,2 


NUMBER OF REMAINING COLUMNS 


0404 




TRA 


T174 


USE (LM-EUl)TH COLUMN OF B 


0405 




REM 






0406 




REM 


REARRANGEMENT 


AND PERMANENT STORAGE ASSIGNMENT 


0407 




REM 






0408 


T212 


CLA 


A 




0409 




STD 


El 




0410 




CLA 


=01000000 




0411 




STD 


E2 




0412 


T216 


LXD 


=0,1 


f 


0413 


T217 


CLA 


E2 




0414 


T218 


SUB 


,1 E,l 




0415 




TZE 


T221 




0416 




TXI 


T217*l,l 




0417 


T221 


PXD 


0,1 




0418 




ADD 


B 




0419 




PDX 


0,1 




0420 




LXD 


El, 2 




0421 




LXD 


LM|4 




0422 


T226 


CLA 


0,1 




0423 




STO 


0,2 




0424 


T228 


TXI 


T229,l,N 




0425 


T229 


TXI 


T230,2,N 




0426 


T230 


TIX 


T226,4#l 




0427 




LXD 


LN,4 




0428 




TNX 


T242,4*l 


THRU WITH XSIMEQ 


0429 




SXD 


LN,4 




C430 




CLA 


El 




0431 




ADD 


=01000000 




0432 




STO 


El 


FIRST ELEMENT, NEXT ROW, MATRIX A 


0433 




CLA 


E2 




0434 




ADD 


=01000000 




0435 




STO 


E2 


NEXT ROW 


0436 




TRA 


T216 




0437 




REM 






0438 




REM 


FINAL RESULTS 




0439 




REM 






0440 


T242 


CLA 


=0 


SOLUTION SUCCESSFUL 


0441 


T243 


LXD 


REG12,1 


RESTORE INDEX REGISTERS 


0442 




LXA 


REG12,2 




0443 




LXD 


Tl-2,4 




0444 




LDQ 


SAVE 


RESTORE LOCATION 8 


0445 




STQ 


8 




0446 


T244 


STO* 


**,4 




044 7 




TRA 


*»,4 




0448 
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T249 


CLA 


= 1. 


SPILL 


0449 




TRA 


T243 




0450 


T251 


LXD 


Tl-2,4 


MATRIX A SINGULAR 


0451 




STZ* 


*» f 4 




0452 




CLA 


=2. 




0453 




TRA 


T243 




0454 




REM 






0455 




REM 


ENTRY POINTS 




0456 




REM 






0457 


T254 


SXD 


Tl~2,4 


ENTRY FOR SIMEQ 


0458 




CLA 


=9 




0459 




STA 


T244+1 




0460 




SUB 


= 1 




0461 




STA 


T244 




0462 




SUB 


= 2 




0463 




STA 


T251+1 




0464 




CLA 


=076100000000 


OCTAL CODE FOR NOP 


0465 




STO 


T38 




0466 




STO 


T77 




0467 




STO 


T122 




0468 




STO 


T165 




0469 




STO 


T298 




0470 




CLA* 


3,4 


THIRD ARGUMENT (LM) 


0471 




STO 


LM 




0472 




CLA 


4,4 


FOURTH ARGUMENT (A) 


0473 




STA 


T282 




0474 




STA 


T285 




0475 




STA 


T286 




0476 




ALS 


18 




0477 




STD 


A 




0478 




CLA 


5,4 


FIFTH ARGUMENT (B) 


0479 




STA 


T284 




0480 




ALb 


1» 




U<*«1 




STO 


B 




0482 




CLA 


7,4 


SEVENTH ARGUMENT (E) 


0483 




STA 


T218 




0484 




STA 


T301 




0485 




ADD 


= I 




0486 




STA 


T80 




0487 




STA 


T81 


\ 


0488 




STA 


T82 




0489 




STA 


T83 




0490 




CLA 


6,4 


SIXTH ARGUMENT (D) 


0491 


T280 


STA 


T28 




0492 




STA 


T29 




0493 




STA 


T68 




0494 




STA 


T69 




0495 




STA 


T89 




0496 




STA 


T90 




0497 




STA 


T163 




0498 




STA 


T164 




0499 




STA 


T281 




0500 




STA 


T283 




0501 




CLA* 


1,4 


FIRST ARGUMENT (N) 


0502 




STO 


N 




0503 




CLA* 


2,4 


SECOND ARGUMENT (LN) 


0504 




CAS 


= 1817 




0505 




TRA 


T287 




0506 


T281 


LDQ 


• * 


D 


0507 


T282 


FMP 


• * 


A( I ) 


0508 


T283 


STO 




D 


0509 


T284 


CLA 


»* 


8(1) OR =1. 


0510 


T285 


FDP 


** 


A( 1 ) OR =1. 


0511 


T286 


STQ 




A(l) OR A (INTERNAL) 


0512 




PXD 


,0 




0513 




TRA 


T244 




0514 


T287 


STO 


LN 




0515 




STD 


Til 




0516 




STD 


T20 




0517 




STD 


T37 




0518 




STD 


T121 




0519 




STD 


T139 




0520 




STD 


T142 




0521 




SUB 


= 1617 




0522 




STD 


T198 




0523 



•*•****•**•*•»•« 

» SIMEQ 
•#*•**••••»•••»« 

I PAGE 8) 



»•*!»*»** 
* 

»#*#*»*» 



PROGRAM LISTINGS 



<»*#•****»•***#•»***••** 
* SIMEQ * 
•«###•«♦*###»*#*#*♦**#»• 

(PAGE 8) 



T298 



T301 



T304 
T305 



T343 



TRA1 



STD 


T304 








0524 


NOP 




TRANSFER TO T305 


FOR XDETRM 


0525 


LXD 


=0,4 








0526 


CLA 


=01000000 








0527 


STO 


,4 E,4 


FILL 


ARRAY E 




0528 


ADD 


=01000000 








0529 


TXI 


T304,4,l 








0530 


TXL 


T301,4,LN-1 








0531 


SXD 


REG12, 1 








0532 


SXA 


REG12.2 








0533 


LOC 


A, 4 








0534 


SXD 


A, 4 








0535 


SXD 


AKK ,4 








0536 


LDC 


B,4 








0537 


SXD 


B,4 








0538 


CLA 


=01000000 








0539 


STO 


K 








0540 


ADD 


=01000000 








0541 


STO 


KPl 








0542 


STZ 


KM1 








0543 


STZ 


KMIN 








0544 


CLA 


LM 








0545 


STD 


T53 








0546 


CLA 


N 








0547 


STD 


T18 








0548 


STD 


T34 








0549 


STD 


T35 








0550 


STD 


T50 








0551 


STD 


T51 








0552 


STD 


Till 








0553 


STD 


T112 








0554 


STD 


T118 








0555 


STD 


T119 








0556 


STD 


T133 








0557 


STD 


T134 








0558 


STD 


T205 








0559 


STD 


T228 








0560 


STD 


T229 








0561 


LDC 


N,4 








0562 


SXD 


T195,4 








0563 


CLA 


8 








0564 


STO 


SAVE 








0565 


CLA 


SPILL 








0566 


STO 


8 








0567 


TRA 


Tl 








0568 


SXD 


Tl-2,4 


ENTRY 


FOR DETRM 




0569 


CLA 


=6 








0570 


STA 


T244+1 








0571 


SUB 


= 1 








0572 


STA 


T244 








0573 


SUB 


= 1 








0574 


STA 


T2S1+1 








0575 


CLA 


TRA1 








0576 


STO 


T38 








0577 


CLA 


TRA2 








0578 


STO 


T77 








0579 


CLA 


TRA3 








0580 


STO 


T122 








0581 


CLA 


TRA4 








0582 


STO 


T165 








0583 


CLA 


TRA5 








0584 


STO 


T298 








0585 


CAL 


T249 








0586 


STA 


T284 








0587 


STA 


T285 








0588 


CAL 


T212 








0589 


STA 


T286 








0590 


CLA 


3,4 


THIRD 


ARGUMENT (A) 


0591 


STA 


T282 








0592 


ALS 


18 








0593 


STD 


A 








0594 


CLA 


4,4 


FOURTH ARGUMENT 


(D) 


0595 


TRA 


T280 








0596 


REM 










0597 


TRA 


T55 








0598 
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TD A 1 


TD A 
1 KA 


T85 




0599 


TO A "i. 
I KA 5 


TD A 
1 KA 


1 I JO 




0600 


1 KA** 


T D A 
1 KA 


1 




060 1 


TD A C 


TRA 


T305 




0602 


A 


PZE 




— A 


0603 


AKK 


PZE 




~A+{ K— 1 ) ( N+l ) 


0604 


AKQ 


PZE 






0605 


B 


PZE 




— 8 


0606 


El 


PZE 






0607 


E2 


PZE 






0608 


t 5 


Pit 






0609 


E4 


D 7 C 
Pit 






0610 


G 


PZE 






061 1 


I 


PZE 






0612 


J 


PZE 






061 3 


K 


r i t 




olAvjt Ur KfcUULIIUN 


0614 


M Ml 

Mil 


Kit 




ft 1 


061 5 




D 7 P 
Kit 




\ f\ l 1 IN 


0616 




D 7P 
Kit 




K + 1 


061 7 


1 M 


PZE 






061 8 


1 M 


D 7 P 
Kit 






061 9 


M 
IN 


PZE 






062 0 


ocri o 
KCO i C 


P 7F 
r ic 








O A V t 


D 7 p 
K it 




rriMTCMTc nc i nr at tniu o 

UUIN 1 tlN 1 o Ur LUUA 1 lUIN o 


062 2 


en f 1 I 
orILL 


TD A 
1 KA 


TP C T 
1 CO 1 


unnic icn tdcatmcmt n c iikincoci nuc 
nUUlrltU iKtAlMcMJ Ur UNUfcKrLuWb 


0623 


TMP 


D 7 C 
r it 




CUNltNlb Ur 1 IMU 1 1» A I UK o 


0624 


TC C T 

It J 1 


STI 


TMP 




0625 




LD I 


0 




0626 




LF T 


4 




062 7 




TRA 


OVE R 


CWTDDCn TC IIKinCDCl nu 

iMPPfcU lr UNUtKrLUW 


062 8 




1 C T 

Lr 1 


2 




0629 




CLM 




SKIPPED IF ONLY MQ UNDERFLOW 


0630 




vr a 










LF T 


I 




0632 




CLM 




SKIPPED IF ONLY AC UNDERFLOW 


0633 




XCA 






0634 




LDI 


TMP 




0635 




TRA* 


0 




0636 


OVER 


LOI 


TMP 




0637 




TRA 


T249 




0638 


SIMEQ 


SYN 


T254 




0639 


DETRM 


SYN 
END 


T343 




0640 
0641 
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* SIZEUP (SUBROUTINE) 3/15/65 LAST CARD IN DECK IS NO. 0246 

* FAP 0001 
•SIZEUP 0002 

COUNT 200 0003 

LBL SIZEUP 0004 

ENTRY SIZEUP (X,LX, INDEX) 0005 

ENTRY SIZUPL (X,LX, INDEX) 0006 

* 0007 

* 0008 
» ABSTRACT 0009 

* 0010 

* TITLE - SIZEUP WITH SECONDARY ENTRY POINT SIZUPL 0011 
« FAST MAKE INDEX ( BY INCREASING SIZE) OF ELEMENTS IN A VECTOR. 0012 

* 0013 

* SIZEUP MAKES A VECTOR, INDEX(I) 1=1. ..LX, WHICH GIVES 0014 
» THE ORDERING, WITH RESPECT TO INCREASING SIZE, OF ANOTHER 0015 
» VECTOR, XU) 1=1. ..LX, SUCH THAT X( INDEX ( I ) ) IS 0016 

* ALGEBRAICALLY GREATER THAN OR EQUAL TO X( INDEX(I-l) ) 0017 
« FOR 1=2... LX. EQUAL VALUES OF XU) WILL NOT 0018 
« NECESSARILY OCCUR IN THE ORDER OF THEIR ORIGINAL 0019 

* APPEARANCE IN THE X VECTOR. +0 IS CONSIDERED GREATER 0020 
» THAN -0 . THE INPUT VECTOR X(I) MAY BE ANY MODE. 0021 

* 0022 
» SIZUPL PERFORMS THE SAME FUNCTION AS SIZEUP EXCEPT 0023 

* THAT THE SORTING IS LOGICAL RATHER THAN ALGEBRAIC. THAT 0024 
« IS, THE SIGN BIT IS CONSIDERED AS THE HIGHEST NUMERICAL 0025 

* BIT. 0026 

* 0027 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN- 1 1 COMPATIBLE) 0028 

* EQUIPMENT - 709, 7090, OR 7094 (MAIN FRAME ONLY) 0029 

* STORAGE - 136 REGISTERS 0030 

* SPEED - AVERAGES ABOUT .0007»LX SECONDS ON 7094 MOD 1 FOR 0031 

* RANDOM NUMBERS BUT WITH DEVIATIONS UP TO 50 PERCENT 0032 
« FROM THIS FORMULA. 0033 

* AUTHORS - R.A.WIGGINS ANO S.M.SIMPSON AUGUST, 1964 0034 

* 0035 

* 0036 

» USAGE 0037 

» 0038 

* TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0039 
» AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0040 

* 0041 

* 0042 

* FORTRAN USAGE OF SIZEUP 0043 

* CALL SIZEUP(X, LX, INDEX) 0044 
« 0045 

* 0046 
» INPUTS 0047 

* 0048 

* X(I) 1*1. ..LX IS A VECTOR IN ANY MODE. 0049 

* 0050 
» LX LENGTH OF X VECTOR. 0051 

* ROUTINE RETURNS WITH NO COMPUTATIONS IF LSTHN 1 . 0052 
» 0053 

* 0054 

* OUTPUTS 0055 

* 0056 

* INDEX(I) 1=1. ..LX IS THE VECTOR OF INDICES AS DESCRIBED IN THE 0057 
» ABSTRACT. 0058 
« 0059 
« 0060 

* FORTRAN USAGE OF SIZUPL - SAME AS SIZEUP. 0061 
« 0062 
« 0063 
« EXAMPLES 0064 

* 0065 

* 1. INPUTS - XU...5) = 3.,-10.,-l.,2.,0. LX = 5 0066 

* USAGE - CALL SIZEUP(X, LX, INDEXl) 0067 
« CALL SIZUPLIX, LX, INDEX2 ) 0068 
« OUTPUTS - INDEXK1...5) = 2,3,5,4,1 0069 

* INDEX2U...5) = 5,4,1,3,2 0070 

* 0071 
« 2. INPUTS - XM...5) * 1HX,1HA,1HC,1HN,1HA LX = 5 0072 
» USAGE - SAME AS EXAMPLE 1. 0073 

* OUTPUTS - INDEXK1...5) = 1,4,5,2,3 0074 
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* 




INDEX2U...5) 


= 5,2,3,4,1 


0075 


• 








0076 


• 








0077 


* PROGRAM FOLLOWS BELOW. 




0078 


XR4 


HTR 


0 




0079 




BCI 


It SIZEUP 




0080 


SIZEUP 


STZ 


ZIFALG 


ALGEBRAIC SORTING ENTRY 


0081 




TRA 


SIZUPL+1 




0082 


SIZUPL 


SXO 


ZIFALG, 4 


LOGICAL SORTING ENTRY 


0083 




SXD 


XR4,4 


SAVE 


0084* 




SXA 


XR2,2 


INDEX 


0085 




SXA 


XR1, 1 


REGISTERS, AND 


0086 




STI 


INDIC 


INDICATORS. 


0087 




CLA 


*1B17 




0088 




STO» 


3,4 




0089 




CLA* 


2,4 


GET LX. 


0090 




PDX 


tl 




0091 




SXA 


LX,1 




0092 




CAS 


=0 


CHECK IF LX IS LEGAL. 


0093 




TIX 


»+3,l,l 


LEGAL 


0094 




TRA 


XR1 


ILLEGAL OR LX*1 


0095 




TRA 


XR1 


ILLEGAL 


0096 




SXD 


LX1,1 




0097 




CAL 


3,4 


GET 


0098 




ADO 


= 1 


INDEX 


0099 




STA 


1X1 


ADDRESS 


0100 




STA 


0FT1 


AND 


0101 




STA 


0FT2 


SPREAD 


0102 




STA 


1X2 


IT 


0103 




STA 


1X3 


AROUND. 


0104 




STA 


1X4 




0105 




STA 


1X5 




0106 




STA 


1X6 




0107 




STA 


1X7 




0108 




STA 


1X8 




0109 




STA 


1X9 




0110 




STA 


1X10 




0111 




CAL 


lt4 


GET 


0112 




PAX 


t2 




0113 




TXI 


•♦1,2,1 




0114 




SXA 


XI, 2 




0115 




SXA 


X2,2 




0116 




SXD 


X3,2 




0117 




PXA 


t2 




0118 




SUB 


LX 


SET UP INDEX VECTOR. 


0119 




TXI 


•♦1,1,1 




0120 


I XI 


STO 


**, 1 


••=ADR(INDEXU1 


0121 




ADD 


= 1 




0122 




TIX 


1X1,1,1 




0123 




CLA 


TMIPL 




0124 




SSM 






0125 




STO 


TMIPL 




0126 


CHSIGN 


ZET 


ZIFALG 


IF THIS IS ALGEBRAIC SORT. 


0127 




TRA 


CONT 




0128 




LXA 


LX,1 




0129 


XI 


CLS 


•♦.I 


••*ADR(X)*1 


0130 


TMIPL 


TMI 


*+2 


=TMI FIRST PASS, TPL SECOND PASS 


0131 




COM 






0132 


X2 


STO 


»», 1 


»»=ADR(X)+1 


0133 




TIX 


XI, 1,1 




0134 


CONT 


CLS 


TMIPL 




0135 




TMI 


XIT1 




0136 




STO 


TMIPL 


CONTINUE. 


0137 




A XT 


1,1 


SET UP 


0138 




SXA 


IFTB.l 


INDEX 


0139 




LXA 


LX,2 


REGISTERS 


0140 




SXA 


ILTB,2 


FOR 


0141 




AXT 


0,4 


BEGINNING. 


0142 




LDQ 


*-lB17 


FLAG LAST 


0143 




SLQ« 


1X3 


INDEX. 


0144 


« 








0145 


• THIS 


IS BEGINNING OF MAIN 


PROCESSING LOGIC. 


0146 


* 








0147 



* 0147 

* SET UP THE INDICATORS FROM IBIT*XR4 TO SCAN ON A PARTICULAR BIT. 0148 



0149 
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SETIND CAL =-0 0150 

SXA «+l,4 0151 

ARS *» 0152 

PAI 0153 

* 0154 

* SAVE THE CURRENT SCANNING LIMITS. 0155 

* 0156 
SXD ALSMC, 1 XR1 IS INDEX FOR FORWARD SCANNING. 015? 
SXD SCNDN,2 XR2 IS INDEX FOR BACK SCANNING. 0158 

* 0159 

* SCAN DOWN THE VECTOR FROM IFTB LOOKING FOR 1«S. 0160 
« 0161 
SCNDN TXH ALSM,1,*» »«=ILTB TRANSFER IF ALL BITS ARE SAME. 0162 
CFT1 OFT» »»,1 »*=ADR( INDEX) +1 0163 

TRA SETLM ONE BIT, GO SCAN UP. 0164 

TXI SCNDN, 1,1 ZERO BIT, CONTINUE SCAN. 0165 

* 0166 
« SCAN UP THE VECTOR FROM ILTB TO I8F=IX1 LOOKING FOR 0»S. 0167 

* 0168 
SETLM SXD SCNUP,1 0169 
SCNUP TXL ALSMC, 2»»» ***IBF TRANSFER IF UX2=IBL) = I8F 0170 
CFT2 OFT* «# f 2 »*=ADR( INDEX) +1 0171 

TIX SCNUP, 2,1 ONE BIT, CONTINUE SCAN. 0172 

1X2 CLA **,1 ZERO BIT, 0173 

1X3 LDQ «»,2 EXCHANGE 0174 

1X4 STA »*,2 THE 0175 

XCA INDEX 0176 

1X5 STA »»,1 ADDRESSES AND 0177 

TXI OFTl f l,l CONTINUE SCANNING. 0178 

* 0179 
« THE EXIT FROM SCNUP DOESN'T INDICATE WHETHER ALL BITS WERE SAME. 0180 

* CHECK THIS. 0181 
= U1SZ 
ALSMC TXH BMPR,2,*» »*»IFTB TRANSFER IF MIXED BITS 0183 

* 0184 
» ALL THE BITS WERE ONES OR ZEROS, SCAN ON NEXT BIT. 0185 

* 0186 
ALSM LXA ILTB, 2 RESET IBL, 0187 
ALSM1 LXA IFTB,1 AND RESET IBF. 0188 

PXD ,4 RECORD THE 0189 

SSM 0190 

XCA 0191 

1X6 SLQ **,2 NEW BIT INDICATOR 0192 

TXI *+l,4,l BUMP IBIT 0193 

TXL NWILTD,4,35 AND GO TO SCAN. 0194 

« 0195 

* IF THAT WAS ALL THE BITS, SEEK A NEW RANGE. 0196 
« 0197 
RECON CLA ILTB NEXT RANGE STARTS 0198 

ADD =1 ONE REGISTER AFTER LAST ILTB. 0199 

PAX ,1 SET NEW IBF. 0200 

LX1 TXH EXIT,1,»* **=LX-1 TRANSFER IF LAST WORD IN LIST. 0201 

SXA IFTB,1 SET NEW IFTB. 0202 

LXA IFTB, 2 AND SCAN 0203 

CLA =0 INDEX VECTOR 0204 

1X7 CAS »*,2 **-ADR( INDEXm 0205 

TRA 1X8 FOR NEXT 0206 

NOP 0207 

TXI 1X7,2,1 NEGATIVE VALUE 0208 

1X8 CLA *«,2 THAT DEFINES 0209 

POX ,4 NEW IBIT, AND 0210 

NWILTD SXA ILTB, 2 THAT DEFINES NEW ILTB. 0211 

SXD *+l,l IF NEGATIVE IS IN IFTB REGISTER 0212 

TXL RECON, 2, •* GO BUMP ILTB AGAIN. 0213 

TRA SETIND GO BACK FOR MORE SCANS. 0214 

* 0215 
« CONTROL COMES HERE WHEN IBF MEETS IBL IN MID VECTOR. 0216 

* 0217 
BMPR TIX ALSM1,2,1 BACK OFF ONE ON IBL. 0218 

* 0219 

* END PROCEDURE. INTERPRET INDEX. 0220 
« 0221 
EXIT LXD XR4,4 0222 

LXA LX,1 0223 

1X9 CAL *»,1 0224 



•••••••*«•*»«»»*»*••••*« PROGRAM LISTINGS 

» SIZEUP * 



I PAGE 4) 





PAC 


$2 


X3 


TXI 


*+l,2,»* 




PXD 


1 2 


IXIO 


STO 


»*tl 




TIX 


1X9,1,1 


* GO RESTORE 


X 




TRA 


CHSIGN 


XIT1 


LDI 


INDIC 


XR1 


AXT 




XR2 


AXT 


**,2 




TRA 


4,4 


« 

« DATA 






* 






INDIC 


PZE 




LX 


PZE 




ZIFALG 


PZE 




IFTB 


PZE 




ILTB 


PZE 






END 
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0225 
0226 
0227 
0228 
0229 
0230 
0231 
0232 
0233 
0234 
0235 
0236 
0237 
0238 
0239 
0240 
0241 
0242 
0243 
0244 
0245 
0246 
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************************ 

* SMPRDV * 



REFER TO 
POWER 
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* SMPSON (SUBROUTINE) 9/4/64 LAST CARO IH DECK IS NO* 0196 

* LABEL 0001 
CSMPSON 0002 

SUBROUTINE SMPSON ( JOB, X , LX,DELX ,X INT , I ANS ) 0003 

C 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - SMPSON 0008 
C UNSCALE OR SCALE VECTOR FOR SIMPSON INTEGRAL ANO/OR INTEGRATE 4 0009 

C 0010 

C SMPSON WILL SCALE AN INPUT VECTOR ACCORDING TO THE 0011 

C SIMPSON'S RULE AND RETURN THE SCALED VECTOR AND THE 0012 

C INTEGRAL, OR WILL RETURN THE INTEGRAL AND THE ORIGINAL 0013 

C VECTORS OR WILL UNSCALE A VECTOR WHICH HAS BEES SCALED 0014 

C FOR SIMPSON'S RULE, IF THE DATA LENGTH IS EVEN THE LAST 0015 

C POINT IS INTEGRATED BY THE TRAPEZOIDAL RULE. THE 0016 

C SIMPSON'S RULE SCALES FOR ODD DATA LENGTH ARE 0017 

C 0018 

C DELX*( 1/3, 4/3, 2/3, 4/3,..., 4/3, 1/3) 0019 

C 0020 

C AND FOR EVEN DATA LENGTH SMPSON USES 0021 

C 0022 

C DELX»( 1/3, 4/3, 2/3, 4/3,..., 4/3, 5/6, 1/2). 0023 

C 0024 

C 0025 

C LANGUAGE - FORTRAN-II SUBROUTINE 0026 

C EQUIPMENT - 709,7090,7094 (MAIN FRAME ONLY) 0027 

C STORAGE - 317 REGISTERS 0028 

C SPEED - TAKES ABOUT 25*LX MACHINE CYCLES TO OBTAIN THE 0029 

C INTEGRAL, TO SCALE OR TO UNSCALE. 0030 

C AUTHOR - J.N.GALBRAITH, JR., FEBRUARY 1964 0031 

C 0032 

C 0033 

C USAGE 0034 

C 0035 

C TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0036 

C AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0037 

C 0033 

C FORTRAN USAGE 0039 

C CALL SMPSONl J08,X,LX,DELX,X INT, IANS) 0040 

C 0041 

C 0042 

C INPUTS 0043 

C 0044 

C JOB FORTRAN II INTEGER INDICATES WHICH JOB IS TO BE DONE. 0045 

C =o INTEGRATE BUT LEAVE DATA UNSCALED. (DATA=X| 13.5 0046 

C GRTHN 0 SCALE DATA AND INTEGRATE. 0047 

C LSTHN 0 UNSCALE DATA. 0048 

C 0049 

C X(I) 1=1, LX INPUT FLOATING POINT VECTOR FOR SMPSON OPERATIONS 0050 

C 0051 

C LX FORTRAN II INTEGER. LENGTH OF X( I) VECTOR. GRTHN 3. 0052 

C 0053 

C DELX FLOATING POINT. SPACING BETWEEN X VALUES. 0054 

C SHOULD BE NON-ZERO. 0055 

C 0056 

C 0057 

C OUTPUTS 0058 

C 0059 

C X(I) 1=1 ... LX IS UNCHANGED FOR JOB * 0 . 0060 

C IS SCALED, AS DEFINED IN ABSTRACT, 0061 

C FOR JOB GRTHN 0 . 0062 

C IS UNSCALED (SCALED 8Y RECIPROCALS) 0063 

C FOR JOB LSTHN 0 . 0064 

C 0065 

C XINT SIMPSGN»S RULE INTEGRAL. (NOT CHANGED IF JOB LSTHN 0.1 0066 

C 0067 

C IANS FORTRAN II INTEGER ERROR INDICATOR. 0068 

C =0 NORMAL 0069 

C = -3 ILLEGAL LX 0070 

C 0071 

C 0072 

C EXAMPLES 0073 

C 0074 
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C 1. INPUTS - JOB * o XU...10) » 1, , 2. , 3. , 4. , 3. , 3. ,4. » 2. , fi. * 7, 0075 

C LX = 3 DELX « 0.2 0076 

C OUTPUTS - IANS = -3 0077 

C 0078 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT LX = 4. 0079 

C OUTPUTS - IANS = 0 XINT = 1.5 XU...4) = l.,2.,3.,4. 0080 

C 0081 

C 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT LX = 9. 0082 

C OUTPUTS - IANS ^ 0 XINT = 4.7333333 0083 

C X(l...9) = l.,2.,3.,4., 3., 3. ,4. ,2. ,6. 0084 

C 0085 

C 4. INPUTS - SAME AS EXAMPLE 1. EXCEPT LX « 10. 0086 

C OUTPUTS - IANS * 0 XINT - 6.0333333 0087 

C XU...IO) « 1., 2. ,3. ,4. ,3. ,3. ,4. ,2. ,6. ,7. 0088 

C 0089 

C 5. INPUTS - JOB * 1 XU...10) * 1 . , 2. , 3 . , 4. , 3* , 3. , 4. #2., 6. 47. 0090 

C LX = 10 DELX = 0.2 0091 

C OUTPUTS - IANS « 0 XINT = 6.0333332 0092 

C X<1...10) » 0.0666667, 0.5333333, 0.4, 1.0666667, 0.4, 0093 

C 0.8, 0.5333333, 0.5333333, 1.0# 0.7 C094 

C 0095 

C 6. INPUTS - JOB * -1 XU...10) * SAME AS OUTPUTS FROM EXAMPLE 5. 0096 

C LX a 10 DELX « 0.2 0097 

C OUTPUTS - IANS » 0 XINT = 0. 0098 

C XU...10) * 1., 2. ,3. ,4. ,3. ,3. ,4. ,2. ,6. ,7. 0099 

C 0100 

C 7. INPUTS - JOB - 2 XU...9) » 1. , 2. , 3. , 4. , 3. , 3. , 4. , 2. , 6^ 0101 

C LX = 9 DELX = 0.2 0102 

C OUTPUTS - IANS » 0 XINT = 4.7333332 0103 

C XU...9) = 0.0666667, 0.5333333, 0.4, 1.0666666, 0.4, 0104 

C 0.8, 0.5333333, 0.5333333, 0.4 0105 

C 0106 

C 5. INPUTS — JuB = —2 Xii...^) = ;>Anc aS uuiKuia rnun tAAWPLt /. VLVf 

C LX - 9 DELX = 0.2 0108 

C OUTPUTS - IANS = 0 XINT * 0. 0109 

C X(l.*.9) * 1., 2. ,3. ,4., 3. ,3. ,4. ,2. ,6. 0110 

C 0111 

C 9. INPUTS - JOB = 0 XU...9) = -1. , 2. , 3. , 4. ,-3. , 3. , 4i, 2. *6. 0112 

C LX = 9 DELX = 0.2 0113 

C OUTPUTS - IANS * 0 XINT = 3.7999998 0114 

C XU...9) = SAME AS INPUTS 0115 

C 0116 

CIO. INPUTS - SAME AS EXAMPLE 9. EXCEPT JOB « 1. 0117 

C OUTPUTS - IANS * 0 XINT * 3.7999998 0118 

C XU...9) = -0.0666667, 0.5333333, 0.4, 1.0666666, -0.4, 0119 

C 0.8, 0.5333333, 0.5333333, 0.4 0120 

C 0121 

Cll. INPUTS - JOB « -1 X(1...9> = SAME AS OUTPUTS FROM EXAMPLE 10. 0122 

C LX - 9 DELX « 0.2 0123 

C OUTPUTS - IANS = 0 XINT = 0. 0124 

C XU.*.9) = -1., 2. ,3. ,4. ,-3. ,3. ,4. ,2. ,6. 0125 

C 0126 

C 0127 

C PROGRAM FOLLOWS BELOW 0128 

C 0129 

OIMENSION xriOOJ 0130 

I ANS=-3 0131 

IF(LX-3) 99*99,2 0132 

2 IANS=0 0133 

XINT«0. C134 

SCALE«0ELX/3. 0135 

IF( <LX/2)*2-LX) 10,5,10 0136 

C 0137 

C LX EVEN 0138 

C 0139 

5 JSWTCH=1 0140 

GO TO 15 0141 

C 0142 

C LX ODD 0143 

C 0144 

10 JSWJCH=0 0145 

15 NN=LX-2 0146 

IF(JOB) 60,20,40 0147 

C 0148 



•*••***••**•******»***•* PROGRAM LISTINGS 

* SMPSON » 

***•#»••••****•****»»*** 

(PAGE 3) 

C INTEGRATE 8UT DO NOT SCALE. 

C 

20 DO 25 1=2, NN, 2 

25 XINT=XINT+4.»X( t)+2,*X< 1*1) 

IF(JSWTCH) 35,30,35 
30 XINT=(XINT*X(1)+X(LX)+4.»X(LX-1) )»SCALE 

GO TO 99 

C 

C DO LAST POINT BY TRAPEZOIDAL RULE 

C 

35 XINT=<XINT+XU) + .5*X(LX-l) + l.5*X(LX) )*SCALE 
GO TO 99 

C 

C SCALE VECTOR AND INTEGRATE. 

C 

40 FACT1=SCALE*4. 

FACT2=SCALE*2. 

DO 45 1=2, NN, 2 

Xm=XU)*FACTl 

X« I+l)=X(I+i)*FACT2 
45 XINT=XINT+X( I)+X( 1+1) 

Xll)=X(l)*SCALE 

IF(JSWTCH) 55,50,55 
50 XCLX)=XCLX)«SCALE 

X<LX-1)=X(LX~1 )#FACT1 

XINT=XINT+Xli)+X<LX)+X( LX-1) 

GO TO 99 
55 X(LX-1)=X(LX-1 )#1.25 

X(LX)=X(LX) *1.5»SCALE 

XINT=XINT+Xll)+X(LX)+X(LX-1)*.2 

GO TO 99 

C 

C UNSCALE VECTOR 

C 

60 FACT1=.25/SCALE 

FACT2=.5/SCALE 

DO 65 1=2, NN, 2 

XU)=XU)*FACT1 
65 X( I+l}=X(I+l)»FACT2 

X( 1)=X(1)/SCALE 

IF(JSWTCH) 75,70,75 
70 X(LX)=X(LX)/SCAtE 

X(LX-1)=X(LX~1)*FACT1 

GO TO 99 
75 X(LX-U = .8*X(LX-1) 

X(LX)=X(LX)/( 1.5*SCALE) 
99 RETURN 

END 
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0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
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SPCOR2 (SUBROUTINE! 9/8/64 LAST CARD IN DECK IS NO* 0180 

LABEL 0001 



CSPC0R2 0002 
SUBROUTINE SPC0R2 (NRX, NCX, XX, NRY, NCY, YY, MXACC* ILGR#NRZ, 0003 
1 ILGC, INC, NCZ, ZZ, SPACE, IANS) 0004 

C 0005 

C — A8STRACT 0006 

C 0007 

C TITLE - SPC0R2 0008 

C SPATIAL CROSSCORRELATION OF 2— 0 1 MENS IONAL SPATIAL ARRAYS 0009 

C 0010 

C SPC0R2 EVALUATES THE SPATIAL CROSSCORRELATION OF AN 0011 

C ARRAY XII, J) 1=1 t . • • ,NRX J=1,...,NCX WITH ANOTHER 0012 

C ARRAY YU,J) 1 = 1,.,., NRY J=1,...,NCY 0013 

C 0014 

C NCX NRX 0015 

C Z(I,4i) * SUM < SUM i X<K+I-1,L+J)>Y1K,L> ) H 0016 

C K=l L=l 0017 

C 0018 

C FOR 1 * ILGR,...,ILGR+NRZ-1 0019 

C J = ILGC,..., ILGC+NCZ-1 0020 

C Jl= ILGC, ILGC+INC,*.., ILGC +( NCZ-1 )* INC 0021 

C WHERE 0022 

C NRX, NCX, NRY, NCY, ILGR, NRZ, ILGC, INC, AND NCZ 0023 

C ARE INPUT PARAMETERS. 0024 

C XUtJ) AND YIUJ) ARE TREATED AS ZERO WHEN I AND J 0025 

C ARE OUTSIDE THE RANGE OF DEFINITION. 0026 

C 0027 

C SPEED IS OBTAINED BY FIXING X(I,J) AND Y(WJ) BETWEEN 0028 

C THE LIMITS OF -MXACC AND MXACC AND THEN USING THE HIGH- 0029 

C SPEED LOGIC OF PROCOR, FASCR1, AND FASEP1 VIA QXC0R1. 0030 

C 0031 

C X(I,J) AND YU,J) ARE SLIGHTLY MODIFIED BY THE FIXING 0032 

C AND REFLOATING PROCESS. 0033 

C 0034 

C USER MUST PROVIDE SPC0R1 WITH A BLOCK OF TEMPORARY 0035 

C REGISTERS OF LENGTH MIN(NRX,NRY) ♦ 10*( MXACC+*) * 1 0036 

C 0037 

C LANGUAGE - FORTRAN II SUBROUTINE 0038 

C EQUIPMENT - 709, 7090, 7094 ( MA IN FRAME ONLY) 0039 

C STORAGE - 291 REGISTERS 0040 

C SPEED - HALF OF THE COMPLETE AUTOCORRELATION OF AN ARRAY 0041 

C TAKES ABOUT 0042 

C (.0070 + .0000040*(NRX SQUARED ))*( NCX SQUARED) 0043 

C SECONDS ON THE 7094 MOD 1. 0044 

C AUTHOR - R.A. WIGGINS JULY, 1963 0045 

C 0046 

C USAGE 0047 

C 0048 

C TRANSFER VECTOR CONTAINS ROUTINES - FLOAT A, FXDATA,QXC0R1 , STZ 0049 

C AND FORTRAN SYSTEM ROUTINES - XLOC 0050 

C 0051 

C FORTRAN USAGE 0052 

C CALL SPC0R2(NRX^NCX, XX, NRY, NCY, YY, MXACC, ILGR, NRZ, 0053 

C 1 ILGC, INC, NCZ, ZZ, SPACE, IANS) 0054 

C 0055 

C INPUTS 0056 

C 0057 

C NRX NUMBER ROWS OF X. 0058 

C MUST BE GRTHN= 1 0059 

C 0060 

C NCX NUMBER COLUMNS OF X. 0061 

C MUST BE GRTHN- 1 0062 

C 0063 

C XX1K) K^I,...,NRX*NCX CONTAINS THE ARRAY X(I,J) 1=1,..., NRX 0064 

C J=1,...,NCX STORED CLOSELY PACKED BY COLUMNS. 0065 

C 0066 

C NRY NUMBER ROWS OF Y. 0067 

C MUST BE GRTHN 3 1 0068 

C 0069 

C NCY NUMBER COLUMNS OF Y. 0070 

C MUST BE GRTHN* 1 0071 

C 0072 

C YYIKi K*1,...,NRY*NCY CONTAINS THE ARRAY Yd, J) I«1,..^,NRY 0073 
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. ,NCY STOREO CLOSELY PACKED BY COLUMNS.! 



MXACC 

ILGR 
NRZ 

ILGC 
INC 

NCZ 

SPACE (I) 

OUTPUTS 
ZZCK) 

IANS 



EXAMPLES 



1. INPUTS 



DEFINES THE ACCURACY OF THE TWO ARRAYS. XX(I) AND YYIII 
WILL BE FIXED SO AS TO HAVE VALUES LYING BETWEEN -MXACC 
AND +MXACC INCLUSIVE, 

INITIAL LAG ALONG ROWS FOR CROSSCORREL AT ION AS DEFINED 
IN THE ABSTRACT. 

NUMBER ROWS IN Z I.E. THE NUMBER OF LAGS ALONfi THE ROWS 

IN THE CROSSCORRELATION. 
MUST BE GRTHN= 1 

INITIAL LAG ALONG COLUMNS FOR CROSSCORRELATION AS DEFINED 
IN THE ABSTRACT. 

INCREMENT IN THE LAG ALONG THE COLUMNS AS DEFINED IN THE 

ABSTRACT. 
MUST BE GRTHN= 1 

NUM8ER COLUMNS IN Z I.E. THE NUMBER OF LAGS ALONG THE 
COLUMNS FOR WHICH THE CROSSCORRELATION IS EVALUATED* 

1=1, , LSPACE IS TEMPORARY COMPUTATION SPACE NEEDED BY 
SPCOR1, WHERE 

LSPACE * MIN(NRX,NRY) ♦ IOMMXACC + 1) ♦ 1 



K=1,».*,NRZ*NCZ CONTAINS ZU,J) I*ILGR,..., ILGR+NRZ-1 
J=ILGC,...,ILGC+NCZ-1 AS DEFINED IN THE ABSTRACT. 

=0 IF NO TROUBLE 

=1 IF ILLEGAL NRX 

=3 IF ILLEGAL NRY 

= 5 IF ILLEGAL MXACC 

=7 IF ILLEGAL NRZ 



NRX 



NCX 



NRY * 2 NCY =3 Y 

MXACC =* 100 ILGR = 
NCZ = 4 
OUTPUTS ~ IANS = 0 ZZU. 



16) 



NRZ 

0.00 
0.44 

1.32 
2.20 



= 0.1 


0.4 


0.7 


0.2 


0.5 


0.8 


0.3 


0.6 


0.9 


* 4.9 


4.7 


4.5 


4.8 


4.6 


4.4 


= 4 


ILGC = 


-2 



INC 



0.00 0.00 0*00 

2.20 5.40 5.U4 

5.39 12.32 11.35 

7.23 15.12 13.28 



(STORED BY 
COLUMNS! 

(STORED BY 
COLUMNS) 
1 

(STORED BY 
COLUMNS) 



2. INPUTS 
OUTPUTS 



SAME AS EXAMPLE 1. EXCEPT INC = 2 
IANS = 0 ZZU. ..8) » 0.00 0.00 
0.44 5.40 
1.32 12.32 
2.20 15.12 



PROGRAM FOLLOWS BELOW 

DIMENSION XX (2) #YY(2) ,ZZ(2) ,SPACE(2) 
CALCULATE FUNDAMENTAL CONSTANTS 
LX=NRX*NCX 
LY=NRY*NCY 
LZ=NRZ*NCZ 

LSPACE=XMINOF(NRX,NRY)+l+lO*(MXACC+l> 

IAUTO * XLOCFCXX)-XLOCF(YY) 
CLEAR THE OUTPUT AREA 

CALL STZ (LZ,ZZ) 
FIX THE INPUTS 

CALL FXDATA ( LX, XX ,MX ACC , SCLX ) 

SCLY=SCLX 

IF (IAUTO) 10,15,10 



(STORED SY COLUMNSI 



0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
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10 CALL FXDATA ( LY , YY ,MXACC,SCLY ) 0149 

15 CONTINUE 0150 

C DO CORRELATIONS 0151 

IDX=NRX»INC 0152 

IX1=XMAX0F(0,ILGR)+ILGC*NRX+1 0153 

NRX1 = NRX~XMAX0F (jO ? ILGR) 0154 

ILGR1=XMIN0F(0, ILGR) 0155 

CXXXXXXXXXX 0156 

DO 50 I2=1,LZ,NRZ 0157 

1X2=1X1 0158 

CXXXXXXXXXXXXXXXXXXXX 0159 

DO 40 I 3*1 1 LY f NRY 0160 

IF (1X2) 30t30,19 0161 

19 IF (LX-IX2) 30,30,20 0162 

20 CALL QXC0R1 ( NRX1 , XX ( I X2 > , NRY , YY ( 1 3 ) , MX ACC, IL GR 1 , NRZ , ZZ I 1 2 )U 1 1 0163 
i LSPACE, SPACE, IANS) 0164 

IF (IANS) 30,30,60 0165 

30 CONTINUE 0166 

40 IX2=IX2+NRX 0167 

CXXXXXXXXXXXXXXXXXXXX 0168 

50 IXl^IXl+IDX 0169 

CXXXXXXXXXX 0170 

C REFLOAT EVERYTHING 0171 

60 CONTINUE 0172 

CALL FLDATA (LX,XX,SCLX) 0173 

CALL FLDATA ( LZ , ZZ , SCLX*SCL Y ) 0174 

IF (IAUTO) 70,80,70 0175 

70 CALL FLDATA ( LY , YY ,SCLY ) 0176 

80 CONTINUE 0177 

C THAT'S ALL THERE IS TO IT, 0178 

RETURN 0179 

END 0180 
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* SPLIT (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0394 
» FAP 0001 
♦SPLIT 0002 

COUNT 400 0003 

LBL SPLIT 0004 

ENTRY SPLIT fX,LX, TYPE, SYM, ANT) 0005 

ENTRY REFIT CX , LX , TYPE , SYM, ANT ) 0006 

* 0007 

* ABSTRACT 0008 

* 0009 

* TITLE - SPLIT WITH SECONDARY ENTRY POINT REFIT 0010 

* SPLIT A VECTOR INTO ITS EVEN AND ODD PARTS {OR INVERSE) 0011 
» 0012 

* SPLIT FINDS THE SYMMETRIC AND ANTISYMMETRIC PARTS OF A 0013 

* FIXED OR FLOATING POINT VECTOR. THE ORIGIN IS ASSUMED 0014 
» TO BE AT THE MIDPOINT OF THE VECTOR. THE VECTOR MAY BE 0015 

* OF EVEN OR ODD LENGTH. STORAGE OF THE PARTS ON TOP OF 0016 

* THE VECTOR IS PERMITTED. 0017 

* 0018 

* REFIT PUTS THE PARTS BACK TOGETHER TO REFORM THE VECTOR. 0019 

* 0020 

* LANGUAGE - FAP 4 SUBROUTINE (FORTRAN II COMPATIBLE) 0021 

* EQUIPMENT - 709* OR 7090 (MAIN FRAME ONLY) 0022 

* STORAGE - 224 REGISTERS 0023 
» SPEED - SPLIT (FIXED)— ABOUT 180 + 23*LX MACHINE CYCLES 0024 

* (FLTG) - ABOUT 180 ♦ 34*LX MACHINE CYCLES 0025 
» REFIT (FIXED)- ABOUT 180 ♦ 23*LX MACHINE CYCLES 0026 

* (FLTG) - ABOUT 180 + 68*LX MACHINE CYCLES 0027 

* WHERE LX = LENGTH OF SERIES 0028 

* AUTHOR - S.M. SIMPSON 0029 

* 0030 

* -USAGE — — 0031 

* 0032 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0033 
» AND FORTRAN SYSTEM ROUTINES - NONE 0034 

* 0035 
» FORTRAN USAGE OF SPLIT 0036 
» CALL SPLITOX,LX, TYPE, SYM, ANT) FOR FLTG. PT. DATA 0037 

* 0038 

* (FOR FIXED PT. DATA X,SYM AND ANT WOULD BE FIXED POINT NAMES! 0039 

* 0040 

* INPUTS TO SPLIT 0041 

* 0042 

* X(I) 1=1. 4. LX IS A FIXED OR FLOATING POINT VECTOR 0043 

* 0044 

* LX IS FORTRAN II INTEGER = LENGTH OF X SERIES 0045 

* SHOULD EXCEED ZERO 0046 
» riF LX IS LSTHN= 0 PROGRAM EXITS WITH NO OUTPUT) 0047 

* 0048 

* TYPE » 0.0 SIGNIFIES X(I) IS FIXED POINT 0049 
« » 1.0 SIGNIFIES X(I) IS FLOATING POINT 0050 
» 0051 

* OUTPUTS 0052 

* 0053 

* SYM(I) I=i.*.LS HOLDS SYMMETRIC PART, WHERE 0054 

* FOR LX ODD, LS = (LX+15/2 AND 0055 
» SYM(l) * X(LS) 0056 

* SYM(I) = X(LS-1>I) + X(LS+1-I) 1=2,3,... iLS 0057 
» FOR LX EVEN, LS =, LX/2 AND 0058 

* SYM(I) = XtLS+l) + X(LS+1-I) 1=1,2, ...,LS 0059 

* 0060 
» ANT ( I ) 1=1. ..LA HOLDS ANTISYMMETRIC PART, WHERE 0061 
» FOR LX ODD, LA = (LX-D/2 AND 0062 

* ANT { I ) = X(LS+I) - X(LS-I) 1= U2,.J.#LA 0063 

* FOR LX EVEN, LA = LX/2 AND 0064 

* ANT ( I ) = X4LA+I) - X(LA+1-I) 1= 142,.«!.*LA 0065 
» (ANT! I > IS AN OUTPUT ONLY IF LA IS GRTHN=l) 0066 

* 0067 
» (SYM AND ANT WILL BE FIXED OR FLOATING ACCORDING TO TYPE) 0068 

* STORAGE OF SYM AND ANT ON TOP OF X SERIES IS PERMITTED 0069 
» ONLY IF SYM(l) IS EQUIVALENT TO X(l) 0070 

* AND ANT ( 1 ) IS EQUIVALENT TO X(LS+1) 0071 

* 0072 

* FORTRAN USAGE OF REFIT 0073 
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« CALL REFIT ( X, LX, TYPE ,SYM, ANT ) FOR FLTG. PT. DATA 0074 

• 0075 

• (FOR FIXED PT, DATA X, SYM AND ANT WOULD BE FIXED PT. NAMES) 0076 

• 0077 

• INPUTS TO REFIT 0078 

• 0079 

• LX SAME MEANING AS FOR SPLIT 0080 

• 0081 
» TYPE SAME MEANING AS FOR SPLIT 0082 
» 0083 
» SYM(I) 1=1. ..LS IS SYMMETRIC PART 0084 

• 0085 

• ANT ( I ) 1=1.*. LA IS ANTISYMMETRIC PART (NOT USED IF LA*0* 0086 
» 0087 
» OUTPUTS FROM REFIT 0088 

• 0089 
» X(I) 1 = 1. -.LX IS REFITTED SERIES FROM SYM AND ANT, 1IHERE 0090 

• FOR LX ODD 0091 

• X(I) = (SYM(LS+1-I) - ANT(LS-I))/2. f=1.4*LS-l 0092 
» X(LS) = SYM(l) 0093 

• X(I) = (SYM(I-LA) ♦ ANT( I-LA-D/2. I*LS*I*JJLX 0094 
» FOR LX EVEN 0095 
» X(I) = (SYM(LS+1-I) - ANT(LS*l-I))/2. 1 = 1. 4. LS 0096 

• X(I) = (SYM(I-LS) ♦ ANT(I-LS))/2. l*LS*UikLX 0097 

• 0098 

• ( NOTE- FOR FIXED DATA, DIVISION BY 2 INCLUDES ROUNDING 0099 
» INTO BIT 35) 0100 
« 0101 

• EXAMPLES 0102 

• 0103 

• I. PARTS AWAY, REFIT AWAY, LX ODD, FIXED AND FLOATING 0104 

• INPUTS - X(1...7) = 80. ,60. ,50. ,40. ,30. ,20. ,10. 0105 
» IX(l...7)= 80,60,50,40,30,20,10 LX=7 0106 

• USAGE - CALL SPLIT ( X, LX, 1 .0, SYM, ANT ) 0107 

• CALL REFIT ( Y, LX*1.0,SYM, ANT) 0108 
» GALL SPLIT ( IX, LX, 0.0, I SYM, I ANT ) 0109 

• CALL REFIT ( I Y,LX,0. , ISYM, I ANT) 0110 

• OUTPUTS - SYM(l.w.4) = 40. , 80. ,80. , 90. ANT(U*.3) = -20.,~40* *-70w 0111 
« Yd. ..7) = XU...7) 0112 
» ISYM(1^..4j = 40,80,80,90 IANT(1..*3) » -20,-40*-70 0113 
» 1YU...7) = IXU...7) 0114 
» 0115 
» 2. PARTS AWAY, REFIT AWAY, LX EVEN, FIXED AND FLOATING 0116 

• INPUTS - SAME AS EXAMPLE 1. EXCEPT LX=6 0117 

• USAGE - SAME AS EXAMPLE 1. 0118 

• OUTPUTS - SYM(l.w.3) = 90^,90. ,100. ANT(i*..3) * -10. ,-30. ^-60. 0119 

• Yd. ,.6) = XU...6) 0120 

• ISYMU...3) = 90,90,100 IANT(l.-.3) = -10^-30^-60 0121 

• IY(1^..6I = IXU...6) 0122 

• 0123 
» 3. PARTS ON TOP* REFIT ON TOP, LX ODD, FIXED AND FLOATING 0124 
» INPUTS - SAME AS EXAMPLE 1. 0125 

• USAGE - CALL SPLIT ( X,LX, 1.0,X,X( 5) ) 0126 

• CALL REFIT ( X,LX, 1.0„X r X( 5) ) 0127 
» CALL SPLIT ( IX,LX,0.0, IX,IX(5)) 0128 

• CALL REFIT ( IX,LX,0.0, IX, IX( 5) ) 0129 
» OUTPUTS - X11...7) = 80. ,60. ,50. ,40. ,30., 20. ,10. 0130 

• IX(U.*7) * 80,60,50,40,30,20,10 0131 

• (NOTE- FOLLOWING FIRST CALL OF SPLIT XU..J7) * 0132 
« 40#, 80. ,80. ,90. ,-20. ,-40. ,-70.) 0133 

• 0134 
» 4. PARTS ON TOP, REFlT ON TOP, LX EVEN, FIXED AND FLOATING 0135 
» INPUTS - SAME AS EXAMPLE 2. 0136 

• USAGE - CALL SPLIT ( X,LX , 1 .0 ,X ,X ( 4 ) ) 0137 
» CALL REFIT ( X,LX, 1.0,X,X( 4) ) 0138 

• CALL SPLIT ( IX,LX,0.0,IX,IX(4)) 0139 

• CALL REFIT ( IX,LX,0.0, IX, IX(4) ) 0140 

• OUTPUTS - X(l.*.6) = 80. ,60. ,50. ,40. ,30. ,20. 0141 

• IXU...6) = 80,60,50,40,30,20 0142 

• 0143 

• 5. CHECK ON SPECIAL CASES LX=1, LX=2 0144 

• INPUTS - SAME AS EXAMPLE 1. 0145 

• USAGE - CALL SPLIT ( X , 1, 0.0, SYM, ANT ) 0146 

• CALL REFIT ( Y , 1 ,0.0, SYM, ANT ) 0147 
» GALL SPLIT (IX,2,0.0,ISYM,IANT) 0148 
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• 




GALL 


REFIT ( IY, 2,0.0, ISYM,IANT) 


0149 


• OUTPUTS - 


SYMU) 


= 80. ANT(l) = UNDEFINED Y(l) * 80. 


0150 


• 


ISYMil! = 


140 IANT(l) * -20 IY(1.*.2) = 80,66 


0151 


• 








0152 


• PROGRAM FOLLOWS BELOW 




0153 


• NOTATION 


EQUIVALENCES USED IN PROGRAM NOTES 


0154 


• 


M * LX 






0155 


• 


N * LS 






0156 


• 


P a LA 






0157 


• 








0158 


HTR 


0 






0159 


BCI 


1 1 SPLIT 




0160 


SPLIT STZ 


S65 




SET PROGRAM INDICATOR * 0 


0161 


TRA 


S2 






0162 


REFIT CLA 


S55 




SET PROG INDIC » 1 


0163 


STA 


S65 






0164 


S2 SXD 


SPLIT- 


2,4 


SAVE IR4 FOR STD ERROR PROC 


0165 


SXA 


S49+1, 


1 




0166 


SXA 


S49+2, 


2 




0167 


CLA* 


3,4 




SET FIXED-FLOATING 


0168 


STO 


S64 




INDICATOR 


0169 


CLA» 


2,4 




GET M 


0170 


ARS 


18 




IN ADDRESS 


0171 


STO 


S62 




STORE IT 


0172 


CAS 


S67 




CHECK M 


0173 


TRA 


♦♦3 




M GRTR 1 


0174 


TRA 


S200 




SPECIAL CASE M*l 


0175 


TRA 


S49 




ILLEGAL M, GO EXIT 


0176 


LRS 


1 




FORM P=M/2 OR (M-D/2 


0177 


STO 


S63 




STORE P 


0178 


STO 


S68 




STORE TRIAL N=P 


0179 


LLS 


I 




CHECK IF M 


0180 


LBT 






OOD OR EVEN 


0181 


TRA 


S3 




EVEN 


0182 


TRA 


S4 




ODD 


0183 


S3 STZ 


S61 




SET EVEN-ODD INDIC=0 (EVEN! 


0184 


TRA 


S18 




(TRIAL N OK) 


0185 


S4 CLA 


S55 




SET EVEN-ODD INDIC =1 <00D) 


0186 


STA 


S61 






0187 


CLA 


S68 




INDEX TRIAL N BY 1 


0188 


ADD 


S67 






0189 


STO 


S68 






0190 


S18 CLA 


S63 




SET P IN DECREMENT OF 


0191 


ALS 


18 




ONE LOOP COUNTER 


0192 


STD 


S39 






0193 


CLA 


S68 




SET 


0194 


ALS 


17 




N/2 TRUNCATED 


0195 


STD 


S80 




IN DECREMENT 


0196 


CLA 


4,4 




SET 


0197 


ADO 


S67 




XS+1 ADDR 


0198 


STA 


S81 






0199 


STA 


S83 




AND 


0200 


SUB 


S67 




XS-N ADDR. 


0201 


SUB 


S68 






C202 


STA 


S82 




IN REVERSE SYM LOOP 


0203 


STA 


S84 






0204 


NZT 


S65 




IS IT SPLIT OR REFIT 


0205 


TRA 


S6 




(SPLIT IF ZERO) 


0206 


•SET UP EXCHANGE AND 


MIDPOINT ROUTINES FOR REFIT 


0207 


CLA 


S81 




SET XS + 1 ADDRESS IN 


0208 


STA 


S45 




EXCHANGE 


0209 


STA 


S85 




AND MIDPOINT 


0210 


CLA 


1,4 




SET X*l ADDRESS IN 


0211 


ADD 


S67 




EXCH 


0212 


STA 


S38 




AND MDPT 


0213 


STA 


S86 






0214 


SUB 


S67 




SET X-M ADDRESS 


0215 


SUB 


S62 




IN 


0216 


STA 


S36 




EXCH LOOP 


0217 


CLA 


5,4 




SET XA-P ADDRESS 


0218 


SUB 


S63 




IN 


0219 


STA 


S32 




EXCH LOOP 


0220 


CLA 


S53 




SET S59 


0221 


STA 


S34+1 




STO ADDRESS 


0222 


CLA 


S36 + 1 




SET S60 


0223 
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S100 



S102 



S101 



STA 
ZET 
TRA 
TRA 
CtA 
STO 
STO 
CLA 
STO 
STO 
TRA 
CLA 
STO 
STO 
CLA 
TRA 



S31 + 1 

S64 

SlOO 

SlOl 

S50 

S30 

S33 

S52 

S31 

S34 

S7 

S55 

S30 

S33 

S56 

S102 



♦SET UP EXCHANGE AND 



S6 



CLA 
STA 
CLA 
STA 
CLA 
STA 
STA 
CLA 
ADD 
STA 
STA 
SUB 
SUB 
STA 
CLA 
SUB 
STA 



S36+1 
S34+1 
S53 
S31 + 1 
S81 
S86 
S36 
1,4 
S67 
S85 
S45 
S67 
S62 
S32 
5,4 
S63 
S38 



PROGRAM LISTINGS 



STO ADDRESS 
FXD OR FLTG 
FLTG 
FXD 

SET FDP INSTR 



SET XCA INSTR 



SET LRS INSTR 



SET RND INSTR 

MIDPOINT ROUTINES FOR SPLIT 
SET S60 
STO ADDRESS 
SET S59 
STO ADDRESS 
SET XS+1 ADDRESS 
IN MDPT 
IN EXCH 

SET X+l ADDRESS 

IN MOPT 
IN EXCH 

SET X-M ADDRESS 
IN EXCH 

SET XA-P ADDRESS 



IN EXCH 

•SET EXCH LOOP FOR EITHER FXD OR FLTG POINT SPLIT 
S9 CLA S66 SET 4 NOP*S 



CLA 
STO 
STO 
STO 
STO 
TRA 



S66 
S30 
S31 
S33 
S34 
S7 



•FINISH SETTING FOR 



S7 ZET 
TRA 
TRA 

S13 CLA 
STO 
CLA 
STO 
TRA 

S12 CLA 
STO 
CLA 
STO 
S14 ZET 
TRA 
TRA 
S90 CLA 
STA 
CAL 
ANA 
ORA 
SLW 
CAL 
ANA 
ORA 
SLW 
TRA 

S91 CLA 
STA 
CAL 
ANA 
ORA 
SLW 
CAL 



S64 

S12 

S13 

S57 

S35 

S58 

S37 

S14 

S53 

S35 

S54 

S37 

S65 

S90 

S91 

S36 + 1 

S3 5 

S36 

S99 

S97 

S36 

S3 8 

S99 

S98 

S38 

S15 

S53 

S35 

S36 

S99 

S98 

S36 

S38 



EITHER SPLIT OR REFIT 
FIXED OR FLTG 
FLTG 
FIXED 

SET ADD AND SUB INSTRUCTIONS 



SET FAD AND FSB INSTRUCTIONS 



SPLIT OR REFIT 

REFIT 

SPLIT 

REFIT - PATCH UP S60 ADDRESS 
IN LOOP 

GET INSTR WITH WRONG TAG 
WIPE OUT TAG 
PUT IN TAG OF 2 

REPEAT 

PUT IN TAG OF 1 

ON TO REFIT SEQUENCE 

SPLIT - PATCH UP S59 ADDRESS 

GET INSTR WITH WRONG TAG 

WIPE OUT TAG 

PUT IN TAG OF ONE 



DITTO 
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0224 
0225 
0226 
0227 
0228 
0229 
0230 
0231 
0232 
0233 
0234 
0235 
0236 
0237 
0238 
0239 
0240 
0241 
0242 
0243 
0244 
0245 
0246 
0247 
0248 
0249 
0250 
0251 
0252 
0253 
0254 
0255 
0256 
0257 
0258 
0259 
0260 
0261 
0262 
0263 
0264 
0265 
0266 
0267 
0268 
0269 
0270 
0271 
0272 
0273 
0274 
0275 
0276 
0277 
0278 
0279 
0280 
0281 
0282 
0283 
0284 
0285 
0286 
0287 
0288 
0289 
0290 
0291 
0292 
0293 
0294 
0295 
0296 
0297 
0298 
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ANA 


S99 




0299 




ORA 


S97 PUT IN TAG OF 


2 


0300 




SLW 


S38 




0301 




TRA 


S16 ON TO SPLIT SEQUENCE 


0302 


S99 


OCT 


-377777077777 




0303 


S98 


PZE 


Otl ,0 




0304 


S97 


PZE 


0,2,0 




0305 


S15 


TSX 


$48,4 REFIT SEQUENCE 




0306 




TSX 


S47,4 




0307 




TSX 


S44,4 




0308 




CLA 


S83 XS + l AVOID 




0309 




STA 


S61 REREVERSE 




0310 




LXA 


S38,4 X+l IF 




0311 




PXA 


0,4 X=XS 




C312 




SUB 


S61 




0313 




TZE 


*+2 




0314 




TSX 


S48,4 




0315 




TRA 


S49 




0316 


S16 


TSX 


S44,4 SPLIT SEQUENCE 




0317 




TSX 


S47,4 




0318 




TSX 


S48,4 




0319 




TRA 


S49 




0320 


•EXCHANGE LOOP 






0321 


S44 


AXT 


1,1 FOR FOR 


FOR FOR 


0322 




AXC 


1,2 SPLIT SPLIT 


REFIT REFIT 


0323 


» 




FIXED FLTG 


FIXED FLTG 


0324 


S45 


CLA 


•«,1 CLA X+l, 1 CLA X+l, 1 


CLA XS+l, 1 CLA XS+W1 


0325 


S30 


NOP 


** NOP NOP 


LRS I FDP S51 


0326 


S31 


NOP 


** NOP NOP 


RND XCA 


0327 




STO 


♦* STO S59 OR 


STO S60 


0328 


S32 


CLA 


•♦#2 CLA X-M,2 CLA X-M,2 


CLA XA-P,2 CLA XA-P#2 


0329 


S33 


NOP 


** NOP NOP 


LRS 1 FDP S51 


0330 


S34 


NOP 


♦* NOP NOP 


RND XCA 


0331 




STO 


** STO S60 OR 


STO S59 


C332 


S35 


NOP 


*« ADD S59 FAD S59 


ADD S60 FAD S60 


0333 


S36 


STO 


**#1 STO XS+1,1 STO XS+1,1 


STO X~M,2 STO X-M*2 


0334 




CLA 


S60 




0335 


S37 


NOP 


** SUB S59 FSB S59 


SUB S59 FSB S59 


0336 


S38 


STO 


♦ »#2 STO XA-P,2 STO XA-P,2 


STO X + 1,1 STO X*l*l 


0337 




TXI 


•+1,1,1 INCREASE I BY 


1 


0338 




TXI 


•+1,2,-1 DECREASE -I BY 


1 


0339 


S39 


TXL 


S45,l»*» **=P 




0340 




TRA 


1,4 




0341 


♦MIDPOINT MOVE 


ROUTINE (IF M IS ODD) ASSUMES IR1 * P+l 


0342 


S47 


NZT 


S61 




0343 




TRA 


1,4 SPLIT REFIT 


0344 




LXA 


S63,l PUT P+l IN IR1 




0345 




TXI 


♦+1,1,1 




0346 


S85 


CLA 


♦*,1 CLA X+1,1 CLA 


XS+1,1 


0347 


S86 


STO 


•«,1 STO XS+1,1 STO 


X + l, 1 


0348 




TRA 


lt4 




0349 


•REVERSE SYMMETRIC PART ROUTINE 




0350 


S48 


AXT 


1,1 




0351 




AXC 


1,2 




0352 


S81 


CLA 


**,1 CLA XS+1,1 




0353 


S82 


LOQ 


**#2 LDQ XS-N,2 




0354 


S83 


STQ 


**,1 STQ XS+1,1 




0355 


S84 


STO 


♦♦♦2 STO XS-N,2 




0356 




TXI 


*+l,l,I 




0357 




TXI 


♦+1,2,-1 




0358 


S80 


TXL 


S81,l,#* **=N/2 TRUNCATED 


0359 




TRA 


lt4 




0360 


» TREAT SPECIAL CASE M=l 




0361 


S200 


CLA 


S65 IS IT SPLIT OR 


REFIT 


0362 




TZE 


S205 




0363 




CLA* 


4,4 REFIT 




0364 




STO* 


1,4 




0365 




TRA 


S49 




0366 


S205 


CLA* 


1,4 SPLIT 




0367 




STO* 


4,4 




0368 


•EXIT ROUTINE 






0369 


S49 


LXD 


SPLIT-2,4 




0370 




AXT 


*** 1 




0371 




AXT 


**,2 




0372 




TRA 


6,4 




037 3 
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•CONSTANTS ETC FOR SPLIT AND REFIT 0374 



S50 


FDP 


S51 






0375 


S51 


DEC 


2.0 






0376 


S52 


XCA 








0377 


S53 


FAD 


S59 






0378 


S54 


FSB 


S59 






0379 


S55 


LRS 


1 






0380 


S56 


RNO 








0381 


S57 


ADD 


S59 






0382 


S58 


SUB 


S59 






0383 


S59 


PZE 


«# 


STORAGE 


FOR X(I)/2 OR XS(I) 


0384 


S60 


PZE 


#* 


STORAGE 


FOR X(M-U-l>)/2 OR XAIP-U-111 


0385 


S61 


PZE 


• » 


**=0 IF 


M EVEN, = 1 IF M ODD 


0386 


S62 


PZE 


** 






0387 


S63 


PZE 


*• 


ft*sP 




0388 


S64 


PZE 


** 


»»=0 IF 


FIXED PT, =1 IF FLTG 


0389 


S65 


PZE 


*• 


♦*=0 IF 


SPLIT, IF REFIT 


0390 


S66 


NOP 








0391 


S67 


PZE 


1 






0392 


S68 


PZE 


*» 


*»=N 




0393 




END 








0394 
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REFER TO REFER TO 

SQROFR SQRDFR 
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* SQRDFR ( SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO» 0110 

* FAP 0001 
♦SQRDFR 0002 

COUNT 100 0003 

L8L SQRDFR 0004 

ENTRY SQRDFR <X,Y,LXY, SSQXMY) 0005 

ENTRY SQRDEV ( X, XBASE, LX , SSQXMB ) 0006 

* 0007 

* — — ABSTRACT 0008 

* 0009 
» TITLE - SQRDFR WITH SECONDARY ENTRY SQRDEV 0010 
» SUM SQUARE D!F. OF FLTG VECTOR FROM ANOTHER OR FROM A CONSTANT 0011 
» 0012 
» SQRDFR SUMS THE SQUARES OF THE DIFFERENCES BETWEEN THE 0013 

* ELEMENTS OF TWO FLOATING VECTORS. 0014 

* 0015 
« SQRDEV SUMS THE SQUARES OF THE DIFFERENCES BETWEEN THE 0016 

* ELEMENTS OF A FLOATING VECTOR AND A CONSTANT. 0017 

* 0018 
» LANGUAGE - FAP SUBROUTINES ( FORTRAN- I I COMPATIBLE) 0019 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0020 
» STORAGE - 36 REGISTERS 0021 

* SPEED - 7090 709 0022 
« 38 + (33.8 OR 37.0)*LX MACHINE CYCLES, LX= VECTOR LENGTH 0023 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 0024 

* 0025 

* USAGE 0026 

* 0027 

* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0028 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0029 

* 0030 

* FORTRAN USAGE 0031 
« CALL SQRDFR( X, Y,LXY, SSQXMY) 0032 

* CALL SQRDEVU, XBASE, LX, SSQXMB) 0033 

* 0034 
» INPUTS 0035 

* 0036 
» X(I) 1=1. ..LXY IS INPUT TO SQRDFR 0037 

* Y(I) 1*1.. .LXY IS INPUT TO SQRDFR 0038 

* LXY SHOULD EXCEED 0 0039 

* 0040 
» X(I) 1=1... LX IS INPUT TO SQRDEV 0041 
» XBASE IS INPUT TO SQRDEV 0042 

* LX SHOULD EXCEED 0 0043 

* 0044 
« OUTPUTS STRAIGHT RETURN WITH NO ACTION IF LXY OR LX LSTHN 1 0045 

* 0046 

* SSQXMY IS SUM (FROM 1 = 1 TO LXY) OF ( Xf I )-Y( I ))•( X ( I )-Y0I ) ) 0047 

* 0048 
» SSQXMB IS SUM (FROM 1=1 TO LX) OF < X ( I )-XBASE )»( X( I )— XBASE) 0049 

* 0050 

* EQUIVALENCE( SSQXMY, ANY INPUT ),( SSQXMB, ANY INPUT) IS 0051 
» PERMITTED. 0052 

* 0053 
» EXAMPLES 0054 
» 0055 

* I. INPUTS - XU...3) = 1., 2., 3. Yd*. .3)= 3., 4. ,5* 5DtF2*0.0 0056 

* USAGE - CALL SQRDFR ( X,Y,3,SDIF1) 0057 

* CALL SQRDEV<X,3.0,3,S0EV1) 0058 

* CALL SQRDFR{ X, Y, 1,X ) 0059 

* CALL SQRDFR(X,Y,0,S0IF2) 0060 
» OUTPUTS - SDIF1 = 12.0 SDEV1= 5.0 X( 1 )= 4.0 0061 

* SDIF2 = 0.0 (NO OUTPUT CASE) 0062 
» 0063 

* PROGRAM FOLLOWS BELOW 0064 

* 0065 

* 0066 
» NO TRANSFER VECTOR 0067 

HTR 0 XR4 0068 

BCI 1, SQRDFR 0069 

* PRINCIPAL ENTRY* SQRDFR ( X, Y, LXY, SSQXMY ) 0070 
SQRDFR CLA 2,4 0071 

ADD Kl A(Y)+1 0072 

STA FSB 0073 

CLA FSB 0074 
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SETUP 


STO 


SUBTR 




0075 




SXD 


SQRDFR— 2,4 




0076 


Kl 


CLA 


1 ,4 




0077 




ADD 


Kl 


A(X)+1 


0078 




STA 


GET 




0079 




CLA* 


3,4 


LXY 


0080 




TMI 


LEAVE 




008 1 




PDX 


0,4 




0082 




TXL 


LEAVE, 4 ,0 




0083 




STZ 


TEMPI 




0084 


* LOOP 








0085 


GET 


CLA 


** , 4 


#♦= A ( X )+l 


0086 


SUBTR 


FSB 


** 1 ** 


= FSB A(Y)+1,4, OR FSB A ( XBASE ) 


0087 




STO 


TEMP2 




0088 




XCA 






0089 




FMP 


TEMP2 




0090 




FAD 


TEMPI 




0091 




STO 


TEMPI 




0092 




TIX 


GET, 4,1 




0093 


* STORE RESULT 






0094 




LXD 


SQRDFR-2,4 




0095 




STO* 


4,4 




0096 


♦ EXIT 








0097 


LEAVE 


LXD 


SQRDFR-2,4 




0098 




TRA 


5,4 




0099 


* SECOND ENTRY. SQRDEV CX, 


XBASE, LX, SSQXMB ) 


0100 


SQRDEV 


CLA 


2,4 


A (XBASE ) 


0101 




STA 


FSBXB 




0102 




CLA 


FSBXB 




0103 




TRA 


SETUP 




0104 


* CONSTANTS, TEMPORARIES 




0105 


FSB 


FSB 


**, 4 


*»=A{ Y)+l 


0106 


FSBXB 


FSB 


•* 


**=A { XBASE ) 


0107 


TEMPI 


PZE 


*♦,»»,#« 


SUM 


0108 


TEMP2 


PZE 


«* , ** , * » 


TEMP FOR DIFFERENCE 


0109 




END 






0110 



•»•*•••***•«•*•»**•**•«* 
» SQRMLI « 
••••••••••»••«*•»#*•.*•#* 



PROGRAM LISTINGS 



«*«•*«*•*»•••***•»•*•»*• 

* SQRMLI » 
**«*•*•*• *«*••**•• 



» SQRMLI (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0127 

* FAP 0001 
•SQRMLI 0002 

COUNT 100 0003 

LBL SQRMLI 0004 

ENTRY SQRMLI (MLIVEC, ILO, IHI ,ML ISQR, IANS) C005 

* 0006 

* — — ABSTRACT 0007 

• 0008 

* TITLE - SQRMLI 0009 
» FAST SQUARE ELEMENTS OF A MACHINE LANGUAGE INTEGER VECTOR 0010 

* 0011 

• SQRMLI TREATS A SPECIFIED RANGE OF A FORTRAN- TYRE VECTOR 0012 

* AS MACHINE INTEGERS? FORMING A SECOND VECTOR WHOSE 0013 

* ELEMENTS ARE THE ML I SQUARES OF THOSE OF THE FIRST 0014 
» VECTOR, CHECKING FOR OVERFLOW. 0015 

* 0016 

* LANGUAGE - FAP SUBROUTINE i FORTRAN II COMPATIBLE) 0017 

• EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0018 

• STORAGE - 55 REGISTERS 0019 

* SPEED - LENGTH OF RANGE TIMES 20 MACHINE CYCLES (AVG INTEGERS) 0020 

• AUTHOR - S.M. SIMPSON JR, JUNE 1962 0021 
» 0022 

♦ — USAGE 0023 

» 0024 

• TRANSFER VECTOR CONTAINS ROUTINES - NONE 0025 

• AND FORTRAN SYSTEM ROUTINES - NONE 0026 

• 0027 
» FORTRAN USAGE 0028 

• CALL SQRMLIfcMLIVECILO, IHI, MLISQR, IANS) 0029 
» 0030 

* INPUTS 0031 

* 0032 

• MLIVECU) I=ILO,*..,IHI IS THE INPUT VECTOR RANGE. 0033 

• 0034 

* ILO MUST EXCEED 0. 0035 
« 0036 

• IHI MUST EQUAL OR EXCEED ILO. 0037 

• 0038 

• OUTPUTS 0039 

• 0040 

♦ MLISQR(I) I*l,2,*..,UHI-IL0+l) CONTAINS 0041 

• SQUAREIML IVEC( ILO,..., IHI) ). 0042 
» 0043 

* IANS * 0 MEANS JOB DONE OK. 0044 

* *-l MEANS ILLEGAL SPECIFICATION OF ILO, IHI. 0045 
» ~-2 MEANS THE SQUARE OF ONE OF THE MLIVEC ELEMSNTS 0046 
» EXCEEDED 35 BITS IN LENGTH ( PROGRAM DOES NOT FINISH 0047 

• SQUARING REST OF ELEMENTS WHEN THIS CONDITION OCCURS) 0048 

* 0049 
» EXAMPLES 0050 

* 0051 

* 1. INPUTS - ML1VEC(1...5)=0CT 2,4,6,10,12 IL0=2 IHI=5 0052 
» OUTPUTS - IANS»0, MLISQFU 1...4)=0CT 20,44,100,144 0053 

• 0054 
» 2. INPUTS - SAME AS EXAMPLE I. EXCEPT ML IVECI 3) =QCT 700000 0055 

• OUTPUTS - IANS =-2 ML ISQRU . . .2 )* OCT 20,210000000000 0056 

* I.E., ML I SQR( 2 ) * LEAST SIGNIFICANT 35 BITS OF 0057 

* OCT 700000 SQUARED = 610000000000 0058 
» 0059 

* 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT IHI-1 0060 

* OUTPUTS - IANS*-1 0061 
» 0062 

HTR 0 0063 

BCI 1, SQRMLI 0064 

SQRMLI SXA EXIT,1 0065 

SXD SQRMLI-2,4 0066 

CLA 2,4 A(AULO)} 0067 

STA GET2 0068 

CLA 3,4 A(AUHI)) 0069 

STA GET3 0070 

CLA 5,4 A(A(IANS)) 0071 

STA PUT5 0072 

» SET UP CONSTANTS ILO, IHI, LVECT AND CHECK THEM. 0073 

• SET IANS FOR ILLEGAL INPUT. 0074 



*»»«»•*««••**••««*••**»* PROGRAM LISTINGS #»*«#*»#*»%#»#*♦»»#*»*♦* 

* SQRMLI » « SQRMLI * 

**••••••*#«•**»•**•»**** «#*#««*»*•*••«•*•*•*»*** 
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CLS 


Kl 




0075 


STO 


IANS 




0076 


GET2 CLA 


*• 


A( ILO) 


0077 


ARS 


18 




0078 


SCO 


ILO 




0079 


TMI 


LEAVE 




0080 


TZE 


LEAVE 




0081 


GET 3 CLA 


** 


A( IHI) 


0082 


ARS 


18 




0083 


STO 


IHI 




0084 


TMI 


LEAVE 




0085 


TZE 


LEAVE 




0086 


SUB 


ILO 




0087 


ADO 


Kl 




0088 


STO 


LVECT 




0089 


TMI 


LEAVE 




0090 


TZE 


LEAVE 




0091 


* SET LOOP UP 






0092 


CLA 


1 »4 


A(A(MLIVEO) 


0093 


SUB 


ILO 




0094 


ADO 


K2 




0095 


STA 


LDQ 




0096 


STA 


MPY 




0097 


CLA 


4,4 


A( A( ML ISQR) ) 


0098 


ADO 


Kl 




0099 


STA 


STQ 




0100 


• SET IANS FOR 


POSSIBLE 


OVERFLOW INDICATION DURING LOOP. 


0101 


CLS 


K2 




0102 


STO 


IANS 




0103 


♦ LOOP 






0104 


LXA 


LVECT, 1 




0105 


LDQ LDQ 


**, 1 


A(MLIVEC)-ILO+2 


0106 


MPY MPY 


*»♦ 1 


AlMLIVEO-ILO+2 


0107 


STQ STQ 


**,l 


A(MLISQR)+1 


0108 


TNZ 


LEAVE 




0109 


TIX 


LDQ, 1,1 




0110 


* ALL OK IF FALLS THRU 


LOOP. 


0111 


STZ 


IANS 




0112 


# STORE IANS AND LEAVE. 




0113 


LEAVE CLA 


IANS 




0114 


ALS 


18 




0115 


PUT5 STO 


*• 


A( IANS) 


0116 


EXIT AXT 


**, 1 




0117 


TRA 


6,4 




0118 


» CONSTANTS 






0119 


Kl PZE 


1 




0120 


K2 PZE 


2 




0121 


* VARIABLES 






0122 


ILO PZE 


** 




0123 


IHI PZE 


*# 




0124 


IANS PZE 


*« 


0 OR -I OR -2 


0125 


LVECT PZE 


** 


IHI-ILO+l 


0126 


END 






0127 



•••••«•»•««•*•**•••••»*• PROGRAM LISTINGS *••*•*••*• 

• SQROOT * # SQROOT * 

•••*•••«•»**•**»•«**«**• «»««•«»•*••»*##•**•*•»*• 



SQROOT (SUBROUTINE) 
FAP 



9/29/64 LAST CARD IN DECK IS NO. 



►SQROOT 



COUNT 100 
LBL SQROOT 

ENTRY SQROOT ( X,LX,XSQRTD ) 

* ABSTRACT — 

* 

* TITLE - SQROOT 

* SQUARE ROOT OF A FLOATING VECTOR 
• 

» SQROOT FORMS A VECTOR WITH ELEMENTS EQUAL TO THE SQUARE 

* ROOTS OF THE ELEMENTS OF ANOTHER (FLOATING! VECTORS 

* OUTPUT MAY REPLACE INPUT, 
• 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN—I I COMPATIBLE) 
« EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 

- 24 REGISTERS 

- ABOUT 31 + 220*LX MACHINE CYCLES, LX » VECTOR LENGTH 

- S.M. SIMPSON, AUGUST 1963 

USAGE 



* STORAGE 

* SPEED 

* AUTHOR 



• TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 

» AND FORTRAN SYSTEM ROUTINES - SQRT (FUNCTION) 

* 

« FORTRAN USAGE 

* CALL SQROOT(X,LX,XSQRTD) 



INPUTS 
X(I) 
LX 

OUTPUTS 



1=1. ..LX IS A NON-NEGATIVE VECTOR 
SHOULO EXCEED 0 

STRAIGHT RETURN WITH NO OUTPUTS IF LX LSTHN 1 



XSQRTDt I ) 1=1.* • LX IS XSQRTDCI) * SQRTFCX(I)). NEGATIVE VALUES 
OF X(I) ARE TREATED AS THOUGH THEY WERE POSITIVE. 



EQUIVALENCE IXSQRTD,X) IS PERMITTED. 



» EXAMPLES 



* 1. INPUTS 
» USAGE 



XSQRT2=0.0 



XU...4) « 100., 200., -300., 400. 
CALL SQR00T(X,4,XSQRT1) 

* CALL SQR00T(X,0,XSQRT2) 
» CALL SQR00T(X,4,X) 

* OUTPUTS - XSQRTU1..*4) = 10.0, 14*1, 17.3, 20.0 

* XSQRT2 = 0.0 (NO OUTPUT CASE) XU...4}* XSQRTH1...4) 
• 

* PROGRAM FOLLOWS BELOW 



» TRANSFER VECTOR CONTAINS SQRT FUNCTION 



0082 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 





HTR 


0 


XR1 


0056 




HTR 


0 


XR4 


0057 




BCI 


1, SQROOT 




0058 


* ONLY 


ENTRY. 


SQROOT(X,LX 


•XSQRTD) 


0059 


SQROOT 


SXD 


SQROOT-2,4 




0060 




SXD 


SQROOT-3,1 




0061 


Kl 


CLA 


1,4 




0062 




ADD 


Kl 


A(X)+l 


0063 




STA 


GET 




0064 




CLA 


3,4 




0065 




ADD 


Kl 


A(XSQRTD)+1 


0066 




STA 


STORE 




0067 




CLA« 


2,4 


LX 


0068 




TMI 


LEAVE 




0069 




PDX 


0,1 




0070 




TXL 


LEAVE, 1,0 




0071 


* LOOP 








0072 


GET 


CLA 


*»,1 


**=A(X)+1 


0073 




SSP 






0074 



•••*••«***•**»****•*»*** PROGRAM 
* SQROOT * 
•••••*•*****«*•********* 
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L I STINGS ***•«* •*•««* »#•«»• + ***•* 

» SQROOT * 
#*•###*#*##•»###»♦♦#**** 

(PAGE 2) 



TSX $SQRT,4 0075 

STORE STO ***1 »»=A(XSQRTD)+1 0076 

TIX GET, 1,1 0077 

« EXIT 0078 

LEAVE LXD SQROOT-2,4 0079 

LXO SQROOT-3,1 0080 

TRA 4,4 0081 

END 0082 



•*•••••••»«•*•*•**»••*#• PROGRAM LISTINGS 

• SQRSUM • « SQRSUM * 

•»*«««•*«•«•*••»**•»**** *•******•*##**•***•**•#* 

* SQRSUM (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0106 

* FAP 0001 
♦SQRSUM 0002 

COUNT 150 0003 

LBL SQRSUM 0004 

ENTRY SQRSUM ( X, LX, SUMSQX) 0005 

ENTRY XSQSUM U X, LIX , IXMSQX ) 0006 

* 0007 

* A8STRACT 0008 

* 0009 

* TITLE - SQRSUM WITH SECONDARY ENTRY XSQSUM 0010 

* SUM THE SQUARED ELEMENTS OF A FLTG OR FXD VECTOR 0011 

* 0012 
» SQRSUM ADDS UP THE SQUARED ELEMENTS OF A FLTG &T VECTOR 0013 
» XSQSUM ADDS UP THE SQUARED ELEMENTS OF A FXD PT VECTOR 0014 

* 0015 
» LANGUAGE - FAP SUBROUTINE ( FORTRAN—I I COMPATIBLE) 0016 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0017 

* STORAGE - 36 REGISTERS 0018 

* SPEEO - 7090 709 0019 
« SQRSUM 42 + (19.6 OR 23.8>»LX MACHINE CYCLES, 0020 

* XSQSUM 39 + (23.4 OR 26.6)*LX LX * VECTOR LENGTH 0021 
» AUTHOR - S.M. SIMPSON, AUGUST 1963 0022 

* 0023 

* USAGE 0024 

* 0025 
» TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0026 
» AND FORTRAN SYSTEM ROUTINES - (NONE) 0027 
» 0028 

* FORTRAN USAGE 0029 

* CALL SQRSUM* X, LX, SUMSQX) 0030 

* CALL XSQSUMOIX, LIX, IXMSQX) 0031 

* C032 

* INPUTS 0033 
» 0034 

* X(I) 1*1.. .LX IS A FLTG VECTOR 0035 

* 0036 

* LX SHOULD EXCEED ZERO 0037 

* 0038 

* IX(I) 1*1.. .LIX IS A FXD VECTOR 0039 

* 0040 

* LIX SHOULD EXCEED ZERO 0041 

* 0042 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LX OR LIX LSTHN 1 . 0043 

* 0044 

* SUMSQX IS SUM OF X(I)*X(I) 0045 

* 0046 

* IXMSQX IS SUM OF IX(I)«IX(I) . CVERPLOW MAY OCCUR AND 0047 

* IS NOT TESTED FOR BY XSQSUM. 0048 

* 0049 
» EXAMPLES 0050 
» 0051 

* 1. INPUTS - X(1...4)=l.,2.,3.,4. IXI 1 . . .4 )=1, 2, 3, 4 U*0.0 0052 
» USAGE - CALL SQRSUM ( X ,4, SUMSQX ) 0053 
» CALL XSQSUM( IX, 4, ISMSQX) 0054 

* CALL SQRSUM(X,1,Y) 0055 

* CALL SQRSUM(X,0,U) 0056 
» OUTPUTS - SUMSQX*30. ISMSQX=30 Y»l. U=0.0 (NO OUTPUT CASE) 0057 

* 0058 

* PROGRAM FOLLOWS BELOW 0059 

* 0060 
» NO TRANSFER VECTOR 0061 

HTR 0 XR4 0062 

BCI 1 , SQRSUM 0063 

* PRINCIPAL ENTRY. S CRSUM ( X,LX, SUMSQX ) 0064 
SQRSUM SXD TEMP, 4 0065 

TRA SETUP 0066 

» SECOND ENTRY. XSQSUM( IX, LIX , ISMSQX ) 0067 

XSQSUM STZ TEMP 0068 

SETUP SXD SQRSUM-2,4 0069 

Kl CLA 1,4 0070 

ADD Kl A(X)+1 0071 

STA LGET 0072 

ST A LMUL 0073 

STA XGET 0074 



•»*##••••*•**•»••*•*••#* PROGRAM 
• SQRSUM # 
••••••••***•*••*•*•»«•*# 
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L ISTINGS 

♦ SQRSUM » 
****«*•••••••****«#*«•** 
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STA 


XMUL 




0075 


CHECK FOR 


ILLEGAL LX 




0076 


CLA* 


2,4 


LX 


0077 


TMI 


LEAVE 




0078 


PDX 


0,4 




0079 


TXL 


LEAVE,4,d 




0080 


BRANCH TO 


PROPER LOOP 




0081 


CLA 


TEMP 




0082 


TZE 


XGET 




0083 


STZ 


TEMP 




0084 


FLOATING LOOP 




0085 


LGET LDQ 


**,4 


**=A(X)+1 


0086 


LMUL FMP 


**,4 


**=A(X)+1 


0087 


FAD 


TEMP 




0088 


STO 


TEMP 




0089 


TIX 


LGET, 4,1 




0090 


TRA 


STORE 




0091 


FIXED LOOP 




0092 


XGET LDQ 


• ♦#4 


•*s A ( X)+l 


0093 


XMUL MPY 


**,4 


•♦=A(X)+1 


0094 


ADD 


TEMP 




0095 


STO 


TEMP 




0096 


TIX 


XGET, 4,1 




0097 


ALS 


17 




0098 


STORE SUM 


OF SQUARES 




0099 


STORE LXD 


SQRSUM-2,4 




0100 


STO» 


3,4 




0101 


EXIT 






0102 


LEAVE LXD 


SQRSUM-2,4 




0103 


TRA 


4,4 




0104 


TEMP PZE 


•* 


♦•=0 IF FXD, LATER SUMMATION 


0105 


END 






0106 



*•••••«»••••»*««•••*•*«* PROGRAM LISTINGS *»«#»**#*#«#*«#««#»•»#*# 

* SQUARE » * SQUARE * 

••»•**••••*••****••**»*• »******#•« ****«»#* 



SQUARE (SUBROUTINE) 
FAP 



9/29/64- 1AST CARD IN DECK IS NO* 



►SQUARE 



COUNT 150 

LBL SQUARE 

ENTRY SQUARE ( X, LX, XSQRD) 

ENTRY XSQUAR ( I X f L IX 1 1 XSQRD ) 

• 

» ABSTRACT 

• 

» TITLE - SQUARE WITH SECONDARY ENTRY XSQUAR 
« SQUARE ELEMENTS OF FXD OR FLTG VECTOR 

» 

» SQUARE FORMS A VECTOR EQUAL TO THE SQUARE OF A GIVEN 

♦ FLTG PT VECTOR. OUTPUT MAY REPLACE INPUT. 
• 

» XSQUAR FORMS A VECTOR EQUAL TO THE SQUARE OF A GIVEN 

• FXD PT VECTOR. OUTPUT MAY REPLACE INPUT. NO TEST 

* MADE FOR OVERFLOW. 



* LANGUAGE 

* EQUIPMENT 

* STORAGE 

* SPEED 



AUTHOR 



- FAP SUBROUTINE ( FORTRAN- I I COMPATIBLE) 

- 709 OR 7090 (MAIN FRAME ONLY) 

- 32 REGISTERS 

7090 709 
SQUARE 37 + (19 OR 22.2)*LX 
XSQUAR 39 + (20.6 OR 24.8)»LX 

- S.M. SIMPSONf AUGUST 1963 

USAGE 



* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 
» AND FORTRAN SYSTEM ROUTINES - (NONE) 
• 

* FORTRAN USAGE 

* CALL SQUARE ( X, LX, XSQRD) 

* CALL XSQUAROIX, LIX,IXSQRD) 



* INPUTS 

* X(I ) 
* 

* LX 

» IXU) 

* LIX 
« 

* OUTPUTS 

* XSQRD(I) 



MACHINE CYCLES, 

XL » VECTOR LENGTH 



1=1. ..LX IS A FLTG VECTOR 
SHOULD EXCEED 0 
1=1. • .LIX IS A FIXED VECTOR 
SHOULD EXCEED 0 

STRAIGHT RETURN WITH NO OUTPUT IF LX OR LIX LSTHN l; 

1=1. ..LX HAS VALUES XSQRDf I )=X( I )»X( I ) 
EQUIVALENCE (X, XSQRD) IS PERMITTED. 



IXSQRD(I) 1=1. ..LIX HAS VALUES IXSQRDI I) = IX( I )» IX ( I ) 

EQUIVALENCE (IX,IXSQRD) IS PERMITTED. OVERFLOW OCCURS 
IF ANY IX HAS MAGNITUDE GRTHN SQRT ( 2** 17- 1J . 



* EXAMPLES 
• 

• 1. INPUTS - X(l.. 

* YY*0. 

♦ USAGE 



OUTPUTS 



Yd. 

Z=l. 



.§)=!., 2. ,...,5. IX( 1...5)=-l.-2,...,-5 

CALL SQUARE(X,5,Y) 
CALL XSQUAR( IX,5,IY) 
CALL SQUARE(X,1,Z) 
CALL SQUARE(X,0,YY) 
CALL XSQUAR( IX, 5, IX) 

.5)=1,4.,9., 16., 25. IY( I... 5) =1,4,9,16,25 
YY=0. (NO OUTPUT CASE) IX ( 1 . . . 5 ) =1 i 4, 9# 16, 25 



* PROGRAM FOLLOWS BELOW 

* NO TRANSFER VECTOR 

HTR 0 XR4 

BCI 1 » SQUARE 

* PRINCIPAL ENTRY. SQUARE ( X, LX, XSQRD) 



0110 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
9069 
0070 
0071 
0072 
0073 
0074 



•««•••**•***«••*»#*•#*•» PROGRAM LISTINGS **##*•*»#*##**•*•«***••« 

* SQUARE » ♦ SQUARE » 

• •*•«••*«•*****##»**<**«* -#**#•»**«»##**»**#*»*♦**♦ 

( PAGE 2) (PAGE 2) 



SQUARE CIA 


FMP 






0075 


LDQ 


NOP 






0076 


SETUP STO 


SQR 






0077 


STQ 


VARY 






0078 


SXD 


SQUARE-2,4 






0079 


Kl CLA 


I ,4 






0080 


ADO 


Kl 


A( X ) + l 




008 1 


STA 


GET 






0082 


STA 


SQR 






0083 


CLA 


3,4 






0084 


ADD 


Kl 


A i XSQRD )+l 




0085 


STA 


STORE 






0086 


* CHECK LX 








0087 


CLA* 


2,4 


LX 




0088 


TMI 


LEAVE 






008 9 


PDX 


0,4 






0090 


TXL 


LEAVE, 4,0 






009 1 


* SQUARING 


LOOP 






0092 


GET LDQ 


♦ *,4 


**- A { X ) ■»- 1 




009 3 


SQR NOP 




- FMP *»,4 OR MPY ♦* f 4 


•♦-A ( Xl + l 


0094 


VARY NOP 




= NOP OR ALS 17 




0095 


STORE STO 


*»,4 


**= A ( XSQRD }+l 




0096 


TIX 


GET, 4,1 






0097 


» EXIT 








0098 


LEAVE LXD 


SQUARE-2,4 






0099 


TRA 


4,4 






0100 


* SECOND ENTRY. XSQUARUX 


,LIXrIXSQRD) 




0101 


XSQUAR CLA 


MPY 






0102 


LDQ 


ALS 






0103 


TRA 


SETUP 






0104 


« CONSTANTS 








0105 


FMP FMP 


*»,4 






0106 


NOP NOP 








0107 


MPY MPY 


** ,4 






0108 


ALS ALS 


17 






0109 


END 








0110 



SRCH1 



PROGRAM LISTINGS 



*•*#**•••»•*••**•«**••*» 
* SRCHl * 
*•••«••*•»*•**•*»*»•»••» 



* SRCH1 (SUBROUTINE) 9/8/64 LAST CARD IN DECK IS NO* 0092 

* LABEL 0001 
CSRCH1 0002 

SUBROUTINE SRCH1 ( JOB, LV ,V,VN, INDEX ) 0003 

C 0004 

C 0005 
C ——ABSTRACT — 0006 

C 0007 

C TITLE - SRCHl 0008 

C SEARCH VECTOR FOR NUMBER, STARTING FROM FIRST OR LAST TERM 0009 

C 0010 

C SRCHl SEARCHES A VECTOR OF FIXED OR FLOATING NUMBERS 0011 

C FOR A PARTICULAR NUMBER* THE INDEX OF THE FIRST NUMBER 0012 

C FOUND IS RETURNED. IF NO SUCH NUMBER IS FOUND THE INDEX 0013 

C IS SET * 0. THE DIRECTION OF SEARCHING i FROM BEGINNING 0014 

C TO END* OR FROM END TO BEGINNING) IS CONTROLLED BY A 0015 

C PARAMETER. PLUS ZERO IS CONSIDERED NOT EQUAL TO MINUS 0016 

C ZERO DURING THE SEARCH. 0017 

C 0018 

C LANGUAGE - FORTRAN II SUBROUTINE 0019 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0020 

C STORAGE - 93 REGISTERS 0021 

C SPEED - TAKES ABOUT 100 ♦ 38»N MACHINE CYCLES ON THE 7090, 0022 

C WHERE N IS THE NO. OF VECTOR ELEMENTS EXAMINED 0023 

C (EXAMINATION STOPS IF VALUE FOUND). 0024 

C AUTHOR - R.A. WIGGINS, AUGUST, 1963 0025 

C 0026 

C USAGE— 0027 

C 0028 

C TRANSFER VECTOR CONTAINS ROUTINES - XACTEQ 0029 

C AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0030 

C 0031 

C FORTRAN USAGE 0032 

C CALL SRCHl iJ0B#LV,V,VN, INDEX) 0033 

C 0034 

C INPUTS 0035 

C 0036 

C JOB =1 FOR FORWARD SEARCHING (BEGINNING WITH LOWEST INDEX) 0037 

C =2 FOR REVERSE SEARCHING (BEGINNING WITH HIGHEST INDEX) 0038 

C 0039 

C LV IS LENGTH OF INPUT VECTOR V. 0040 

C IF LSTHN 1 SRCHl ONE RETURNS WITH INDEX-0 0041 

C 0042 

C V(I) 1 = 1. . « LV IS THE VECTOR TO BE SEARCHED. 0043 

C NEED NOT BE FLOATING POINT MODE. C044 

C 0045 

C VN IS THE VALUE TO BE SEARCHED FOR. 0046 

C SHOULD BE SAME MODE AS V. 0047 

C 0048 

C OUTPUTS 0049 

C 0050 

C INDEX THE INDEX OF THE FIRST VALUE FOUND FOR WHICH 0051 

C V(INOEX) « VN . WILL = 0 IF NONE FOUND. 0052 

C 0053 

C EXAMPLES 0054 

C 0055 

C 1. INPUTS - JOB * I IVN » -1 VN =2. LV * 20 0056 
C VU...20) = -2.*-l.,0.,l.,2.,~3.,..*,0.,l.#2.,-3.,-2.,-t. 0057 

C IV(1»..20)= -2,-1,0,1,2,-3,-2,-1, 0,..., 0*W2,-3, -2,-1 0058 

C USAGE - CALL SRCHl ( JOB, LV,V, VN, INDEX 1) 0059 

C CALL SRCHl ( JOB,LV, IV, IVN,INDEX2) 0060 

C OUTPUTS - INDEX1 * 5 INDEX2 = 2 0061 

C 0062 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT JOB = 2 0063 

C USAGE - SAME AS EXAMPLE 1. 0064 

C OUTPUTS - INDEX1 » 17 INDEX2 = 20 0065 

C 0066 

C 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT JOB = 2 VN = -0.* IVN * -0 0067 

C V(13) * -0. IV(9) = -0 0068 

C USAGE - SAME AS EXAMPLE 1. 0069 

C OUTPUTS - INDEX1 = 13 INDEX2 * 9 0070 

C 0071 

C PROGRAM FOLLOWS BELOW 0072 

C 0073 

DIMENSION V(2) 0074 



•*»••••«•••»**•*»•«»•»•• PROGRAM LISTINGS 

* SRCH1 ♦ 

•**«»•»*••**•**•«••***«* 

(PAGE 2) 

INDEX*0 

IF <LV) 10*10,20 
10 RETURN 
20 CONTINUE 

GO TO (30,40), JOB 
30 J=l 

IJ = l 

GO TO 50 
40 J=LV 

I J=-l 
50 CONTINUE 

DO 70 1=1, LV 

IF ( XACTEQF ( V( J ) , VN) ) 70,60,70 
70 J=J>IJ 

GO TO 10 
60 INDEX=J 

GO TO 10 

END 



4 »•#*•+* •«•»*•»»••**»*»» 

« SRCH1 » 
****«*#•••*•*#****•»»••* 
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0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 



ft*********************** 

» STEPC » 
»«•**#•«»***•»***•*****« 

REFER TO 
DELTA 



PROGRAM LISTINGS 



*»*#»»***##•*#»*«**»*»** 

* STEPC ♦ 
#*»•»«#«»**•»**••**«***« 

REFER TO 
DELTA 



##*»#♦»*##**###*»#♦»**»* 
» STEPL * 
##»•#**««*»*#»**»*»»#**♦ 



REFER TO 
DELTA 



* STEPL * 
*»**»*»•*******«***»**«» 

REFER TO 
DELTA 



•*»*••»•**••••***•»•**** 

* STEPR * 
•»*#**•**##•»**•»**«**»* 

REFER TO 
DELTA 



• STEPR * 
**•#***»#*»*•*•••«*•**»* 

REFER TO 
DELTA 



«**«*«••«••**•«»««•*»«»» 

* ( STH ) * 

««»*««»*#•»•*«*»*«»»«««* 

REFER TO 
CNLINE 



* (STH) ♦ 
***•***»•***•»»*••**»•*» 

REFER TO 
ONLINE 



«*#*##*#«#»#*»#»»#♦»««»* 

* (STHD) * 
*»#«««**#»###**#«»**»»#» 

REFER TO 
CNLINE 



**##*###»*»«*♦»****»*#*» 

» (STHD) * 
»«*•«**»«»»*»»***•*»«»»• 

REFER TO 

ONLINE 



«**««««:*«**»«** «»«»»«»*« 
« (STHM) * 

«**«««**«««*««««**•*••«» 

REFER TC 

CNLINE 



**•**»*•*«*«*»*•»»****** 

» (STHM) » 
*»*»••*•***•*»***•»•«»•* 

REFER TO 

ONLINE 



•*#•**••**•••***»«»#**«* 

* STORE * 



REFER TO 

LOCATE 



#*•*»##**•##•»•«**••#•** 

* STORE * 
**»##•#**#«*#•*•*«••**•* 

REFER TO 
LOCATE 



*»•**•* *«•**•#•**#* *,**#« 
♦ STZ « 
•»*»*•**#****»*»***•**«* 



PROGRAM LISTINGS 



*•***•*»»**»•«*•**«••**• 
* STZ * 
**•*•**•*•*•«•»»*«»•***• 



* STZ { SUBROUTINE ) 9/29/64 LAST CARD IIS DECK IS NO. 0059 

* FAP 0001 
•STZ 0002 

COUNT 50 0003 

LBL STZ 0004 

ENTRY STZ <LX,X) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - STZ 0009 

* FAST SET VECTOR TO ZERO 0010 

* 0011 

* STZ SETS A VECTOR TO ZERO, 0012 

* 0013 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0014 

* EQUIPMENT - IBM 709 OR 7090 (MAIN FRAME ONLY) 0015 

* STORAGE ~ 14 REGISTERS 0016 
» SPEED - ABOUT 4»N + 18 MACHINE CYCLES WHERE N IS THE LENGTH 0017 

* OF THE VECTOR. 0018 
« AUTHOR - J.F. CLAERBOUT 0019 

* 0020 

* —USAGE 0021 

* 0022 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0023 

* AND FORTRAN SYSTEM ROUTINES - NONE 0024 

* 0025 

* FORTRAN USAGE 0026 
« CALL STZ(LX#X) 0027 

* 0028 

* INPUTS 0029 
» 0030 

* XU) 1 = 1. ..LX IS THE VECTOR TO BE SET TO ZERO. 0031 

* NEED NOT HAVE A FLOATING POINT NAME. 0032 
» 0033 
» LX MUST BE GRTHN= 1. 0034 

* IS FORTRAN II INTEGER. 0035 

* 0036 

* OUTPUTS 0037 

* 0038 

* XU ) 1=1. ..LX IS SET TO ZERO. 0039 

* 0040 

* EXAMPLES 0041 

* 0042 

* 1. INPUTS - LX = 5 X< 1...5) = 1. • l.« 1. « 1. t 1. 0043 

* OUTPUTS - XM...5) = 0.,0.,0.,0.,0. 0044 
« 0045 

HTR 0 0046 

BCI 1,STZ 0047 

STZ SXD *-2,4 0048 

CLA 2,4 0049 

ADD =1 0050 

STA Z 0051 

CLA* 1,4 0052 

TZE 3,4 0053 

PDX ,4 0054 

Z STZ ***4 0055 

TIX »-l,4,l 0056 

SV LXD STZ-2,4 0057 

TRA 3,4 0058 

END 0059 



•••••*••*•*•**•••«•**«#• PROGRAM LISTINGS 

• STZS * * STZS • 

••»•*•*»•*•••***••#»*•** «•***• ««•« «•**••* #»*»»•* 



» STZS (SUBROUTINE) 9/29/64 LAST CARO IN DECK IS NO. 0096 

» FAP 0001 

•STZS 0002 

COUNT 100 0003 

LBL STZS 0004 

ENTRY STZS ( LX1 ,X1 ,LX2 ,X2 , . . . ,LXN, XN ) 0005 

• 0006 

• — —ABSTRACT 0007 

• 0008 

• TITLE - STZS 0009 

• SET A LIST OF VECTORS TO ZERO 0010 

• 0011 

• STZS IS A VARIABLE LENGTH CALLING SEQUENCE SUBROUTINE 0012 

• WHOSE ARGUMENTS ARE CONSIDERED IN PAIRS* THE SECOND 0013 

• ARGUMENT OF EACH PAIR IS CONSIDERED TO BE A VECTOR 0014 

• WHOSE LENGTH IS GIVEN BY THE FIRST ARGUMENT. ON OUTPUT 0015 

• ALL SUCH VECTORS WILL BE CLEARED EXCEPT THAT N0 ACTION 0016 

• IS TAKEN ON VECTORS OF NEGATIVE OR ZERO LENGTH* 0017 

• 0018 
» LANGUAGE - FAP SUBROUTINE ( FORTRAN—I I COMPATIBLE) 0019 

• EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0020 

• STORAGE - 24 REGISTERS 0021 

• SPEED - 9 + 25*N + 4*L MACHINE CYCLES, 0022 
» WHERE N = THE NUMBER OF VECTORS TO BE CLEAR8D 0023 

• L = THE SUM OF THEIR LENGTHS 0024 
» AUTHOR - S.M. SIMPSON, SEPTEMBER 1963 0025 

• 0026 

• - USAGE 0027 

» 0028 

» TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0029 

• AND FORTRAN SYSTEM ROUTINES - (NONE) 0030 

• 0031 
» FORTRAN USAGE 0032 

• CALL STZS (LXWX1, LX2,X2, LXN,XN) 0033 

• WHERE THE NO. OF PAIRSt N, SHOULD EXCEED 0 0034 

• 0035 
» INPUTS 0036 

• 0037 
» LX1 IS LENGTH OF FIRST VECTOR. SHOULD EXCEED 0 0038 

• LX2 IS LENGTH OF SECOND VECTOR. SHOULD EXCEED 0 0039 

• ETC 0040 

• LXN IS LEN6TH OF LAST VECTOR. SHOULD EXCEED 0 0041 

• 0042 

• OUTPUTS 0043 
» 0044 

• XIII) 1 = 1. ..LX1 IS XLU) = 0, PROVIDED LX1 GRTHN* 1 0045 

• X2U) I»l...LX2 IS X2U) » 0, PROVIDED LX2 GRTHN= 1 0046 

• ETC 0047 

• XNU) 1 = 1. ..LXN IS XNU) = 0, PROVIDED LXN GRTHN= 1 0048 

• 0049 

• IF ANY LX IS 0 OR NEGATIVE, THE CORRESPONDING VECTOR 0050 

• IS NOT DISTURBED. THE MODES OF THE VECTORS ARE 0051 
» ARBITRARY. 0052 

• 0053 
» EXAMPLES 0054 

• 0055 
« 1. INPUTS - X(l...iO) » 999. Y=Z=W=U= 999. C056 

• IXU...3) * 999 IYU...4) » 999 0057 

• USAGE - CALL STZS(10,X, 3, IX, 1,Y, 0,Z, -2,W,f 4,IY) 0058 

• CALL STZSU,U) 0059 
» OUTPUTS - XU...10) =0. Y = 0. IXU...3) » 0 0060 

• IYll..*4) * 0 Z = W » 999. U = 0. 0061 
» 0062 

• PROGRAM FOLLOWS BELOW 0063 

• 0064 

• 0065 

• NO TRANSFER VECTOR 0066 

HTR 0 XR1 0067 

HTR 0 XR4 0068 

BCI 1,STZS 0069 

» ONLY ENTRY. STZSf LX1 , XI , LX2 , X2 , . . . , LXN ,XN ) 0070 

STZS SXD STZS-2,4 C071 

SXD STZS-3,1 0072 

» EXAMINE FOR NEXT L 0073 

CAL CAL 1,4 0074 
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ANA 


AMASK 




0075 


LAS 


TSXZ 




0076 


TRA 


LEAVE 




0077 


TRA 


CLEAR 




0078 


• EXIT 






0079 


LEAVE LXD 


STZS-3, I 




0080 


TRA 


If 4 




0081 


• CLEARING 


LOOP 




0082 


CLEAR CLA 


2,4 




0083 


ADD 


Kl 


A(X)+1 


0084 


STA 


STZ 




0085 


Kl CLA* 


1,4 


L 


0086 


TMI 


BACK 




008 7 


PDX 


0,1 




0088 


TXL 


BACK,1 ,0 




0089 


STZ STZ 


»*,1 


»*=A(XJ+1 


0090 


TIX 


STZ, 1,1 




0091 


BACK TXI 


CAL,4,-2 




0092 


» CONSTANTS 






0093 


AMASK OCT 


777777700000 




0094 


TSXZ TSX 


0,0 




0095 


END 






0096 



**«**»«•*•«••**********» PROGRAM 
* SUBK * 
#*#**»♦♦*♦*♦♦*##***#♦*#» 

REFER TO 
ADDK 



LI STINGS *#******»•***•••*»**»•*» 
♦ SUBK * 
«»*»*••*»****»*•***»»*»» 

REFER TO 
ADDK 



*«***•*»***#*»*«*»**•»** 

♦ SUBKS * 
**•»***»•**»**««»»*»**** 

REFER TO 
ADDK 



»»#»•»•**•«*»«•**#*»*#«* 

» SUBKS » 



REFER TO 
ADDK 
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* SUM * # SUM * 

• *•«*«•**»*•«*****«•«*#» **»#»•*••««•»*«#*#%*«*•• 



* SUM ( SUBROUTINE ) 9/29/64 LAST CARD IN DECK IS NO. 0091 
» FAP 0001 
•SUM 0002 

COUNT 150 0003 

LBL SUM 0004 

ENTRY SUM ( X, LX, SUMX) 0005 

ENTRY XSUM { I X,LIX, ISUMIX ) 0006 

« 0007 

* ABSTRACT 0008 

* 0009 

* TITLE - SUM WITH SECONDARY ENTRY XSUM 0010 
« SUM ELEMENTS OF FLTG OR FIXED VECTOR 0011 

* 0012 

* SUM ADDS UP ELEMENTS OF A FLTG PT VECTOR. 0013 
» XSUM ADDS UP ELEMENTS OF A FXD PT VECTOR. 0014 

* 0015 

* LANGUAGE - FAP SUBROUTINE, I FORTRAN— 1 1 COMPATIBLE) 0016 

* EQUIPMENT - 709 OR 7090 ( MAIN FRAME ONLY I 0017 

* STORAGE - 23 REGISTERS 0018 

* SPEED - SUM 32 ♦ 8.4»LX MACHINE CYCLES, 0019 
« XSUM 30 + 4*LX LX = VECTOR LENGTH 0020 
» AUTHOR - S.M. SIMPSON, AUGUST 1963 0021 
» 0022 

» USAGE 0023 

» 0024 

« TRANSFER VECTOR CONTAINS ROUTINES - {NONE) 0025 

» AND FORTRAN SYSTEM ROUTINES - I NONE) 0026 

* 0027 

* FORTRAN USAGE 0028 

* CALL SUM ( X, LX, SUMX) 0029 

* CALL XSUMUX,LIX, ISUMIX) 0030 

* 0031 

* INPUTS 0032 
» 0033 

* X(I ) 1=1. ..LX IS A FLTG VECTOR 0034 
» 0035 

* LX SHOULD EXCEED ZERO 0036 
» 0037 
» IXU) 1 = 1.. .LIX IS A FXD VECTOR 0038 

* 0039 

* LIX SHOULD EXCEED ZERO 0040 
» 0041 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LX OR LIX LSTHN 1 . 0042 

* 0043 

* SUMX IS SUM OF XU...LX) 0044 

* 0045 
« ISUMIX IS SUM OF IXU. ..LIX) . OVERFLOW MAY OCCUR AND IS 0046 

* NOT CHECKED FOR BY XSUM. 0047 

* 0048 
» EXAMPLES 0049 

* 0050 
» I. INPUTS - X( l...4)=l.,2.,3.,4. IX! 1.* .4)=i,2, 3, 4 0051 
» U=0.0 0052 

* USAGE - CALL SUM (X, 4, SUMX) 0053 

* CALL XSUM (IX, 4, I SUM I X ) 0054 

* CALL SUM <X, 1,Y) 0055 
» CALL SUM <X,0,U> 0056 

* OUTPUTS - SUMX = 10. ISUMIX = 10 Y = 1. U =. 0. (NO OUTPUT CASE1 0057 

* 0058 

* PROGRAM FOLLOWS BELOW 0059 

* 0060 

* NO TRANSFER VECTOR 0061 

HTR 0 XR4 0062 

BCI 1,SUM 0063 

* PRINCIPAL ENTRY. SUM t X, LX, SUMX ) 0064 
SUM CLA FAD 0065 

TRA SETUP 0066 

* SECOND ENTRY. XSUMCIX, LIX, ISUMIX) 0067 
XSUM CLA ADD 0068 
SETUP STO ADD1 0069 

SXD SUM-2,4 0070 

Kl CLA 1,4 0071 

ADD Kl A(X)+1 0072 

STA ADD! 0073 

* CHECK FOR ILLEGAL LX 0074 
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CLA» 2,4 LX 0075 

TMI LEAVE 0076 

PDX 0,4 0077 

TXL LEAVE, 4,0 0078 

• FORM AND STORE THE SUM 0079 

PXD 0,0 0080 

A0D1 NOP « FAO «*,4 OR ADD **,4 »#=A(X1*1 0081 

TIX ADD1,4,1 0082 

LXD SUM-2,4 0083 

STO» 3,4 0084 

* EXIT 0085 
LEAVE LXD SUM-2,4 0086 

TRA 4,4 0087 

» CONSTANTS 0088 

FAD FAD *»,4 0089 

ADD ADD **,4 0090 

END 0091 



•*••••••**••**••**«#*»•• PROGRAM LISTINGS 

* SUMDEV * 
****#»««»«•*••*•»•»**»•* 

REFER TO 

SUMDFR 



#»•#*••»«***-•#•**«»***•* 

* SUMDEV ♦ 
4m *###•#»*•»••#«***«•»*# 

REFER TO 

SUMDFR 



»•«»»*••••*••*•***•* PROGRAM LISTINGS *»•***#♦»«#*»«#»**»*♦#** 

SUMDFR * # SUMDFR » 

»««««••**••••**»**#* ***#*»«*«*«•«*«•*««»•*#* 



* SUMDFR (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO» 0155 
« FAP 0001 
•SUMDFR 0002 

COUNT 150 0003 

LBL SUMDFR 0004 

ENTRY SUMDFR ( X, Y, LXY, SUMXMY) 0005 

ENTRY XSMDFR { I X , I Y , LXY , ISMXMY ) 0006 

ENTRY SUMDEV < X, XBASE, LX, SUMXMB) 0007 

ENTRY XSMDEV ( I X, I XBASE, L IX, ISMXMB ) 0008 

* 0009 

» —-ABSTRACT 0010 

» 0011 

* TITLE - SUMDFR WITH SECONDARY ENTRIES XSMDFR, SUMDEV AND XSMDEV 0012 
» SUM DIFFERENCE OF VECTOR FROM ANOTHER OR FROM A CONSTANT 0013 
» 0014 
» SUMDFR SUMS THE DIFFERENCES OF TWO FLOATING VECTORS* 0015 

* XSMDFR SUMS THE DIFFERENCES OF TWO FIXED VECTORS^ 0016 

* SUMDEV SUMS THE DEVIATIONS OF A FLOATING VECTOR FROM 0017 

* A CONSTANT. 0018 

* XSMDEV SUMS THE DEVIATIONS OF A FIXED VECTOR FROM 0019 

* A CONSTANT. 0020 

* 0021 

* FOR THE FIXED ENTRIES THE BINARY POINT IS ARBITRARY. 0022 
» 0023 

* LANGUAGE - FAP SUBROUTINES ( FORTRAN—I I COMPATIBLE) 0024 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0025 
» STORAGE - 44 REGISTERS 0026 
» SPEED - SUMDFR 47 + 14.8*LX MACHINE CYCLES, 0027 
» XSMDFR 49 + 6.0«LX LX * VECTOR LENGTH 0028 
» SUMDEV 45 + 14.8»LX 0029 
» XSMDEV 43 ♦ 6.0*LX 0030 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 0031 

* 0032 

* USAGE 0033 

» 0034 

* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0035 

* AND FORTRAN SYSTEM ROUTINES - I NONE ) 0036 

* * 0037 
» FORTRAN USAGE 0038 

* CALL SUMDFR ( X, Y,LXY,SUMXMY ) 0039 

* CALL XSMDFRt IX,IY, LXY, ISMXMY) 0040 

* CALL SUMDEV( X, XBASE* LX, SUMXMB) 0041 
» CALL XSMDEVilX, IXBASE, LIX, ISMXMB) 0042 

* 0043 

* INPUTS 0044 
» 0045 

* X(I) 1=1.. .LXY IS A FLOATING INPUT TO SUMDFR 0046 
» Yd) 1 = 1.. .LXY IS A FLOATING INPUT TO SUMDFR 0047 
» LXY SHOULD EXCEED 0 ( FORTRAN- 1 1 INTEGER) 0048 
» IX(I) 1=1.. .LXY IS A FIXED INPUT TO XSMDFR 0049 

* IYU) 1=1.. .LXY IS A FIXED INPUT TO XSMDFR WITH THE SAME 0050 

* BINARY POINT AS IXC I } 0051 

* 0052 

* X(I) 1=1. ..LX IS A FLOATING INPUT TO SUMDEV 0053 

* XBASE IS A FLOATING CONSTANT 0054 
« LX SHOULD EXCEED 0 ( FORTRAN- 1 1 INTEGER) 0055 

* IX(I) 1=1.. .LIX IS A FIXED INPUT TO XSMDEV 0056 
» IXBASE IS A FIXED CONSTANT WITH THE SAME BINARY POINT AS IXU) 0057 

* LIX SHOULD EXCEED ZERO 0058 
» 0059 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUTS IF LXY OR LX LSTHN 1 0060 

* 0061 
» SUMXMY IS SUPHFROM 1 = 1 TO LXY) OF (X(I) - Y ( H ) 0062 

* 0063 
» ISMXMY IS SUM(FROM 1=1 TO LXY) OF (IXU) - IY(I)> 0064 
» 0065 

* SUMXMB IS SUIMFROM 1 = 1 TO LX) OF <X(I) - XBASE) 0066 

* 0067 

* ISMXMB IS SUIMFROM 1 = 1 TO LIX) CF (IXU) - IXBASE) 0068 
» 0069 

* BINARY POINT OF FIXED OUTPUTS IS SAME AS THAT OF INPUTS. 0070 

* DANGER OF FIXED POINT OVERFLOW IS NOT TESTED FOR. 0071 
» 0072 

* EQUIVALENCE ( SUMXMY , ANY INPUT ) , ( I SMXMY, ANY INPUT), 0073 
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* <SUMXM8,ANY INPUT), USMXMB, ANY INPUT) IS P6RMITTED. 0074 
« 0075 
« EXAMPLES 0076 

* 0077 

* 1. INPUTS ~ XI1...3) = 1. , 2., 3. Yd. ,.3) = 2. ,4. ,6* XBASE * 3. 0078 

* IXC1...3) = 1, 2, 3 IYCU..3) * 2, 4, 6 1XBASE * 3 0079 

* USAGE - CALL SUMDFR ( X, Y, 3, DIED 0080 

* CALL XSMDFRt IX,IY, 3,IDIFl) 0081 

* CALL SUMDEV( X, XBASE, 3, DEVI) 0082 

* CALL XSMOEV( IX, IXBASE, 3,IDEV1) 0083 

* OUTPUTS - DIF1 = -6.0 IDIF1 = -6 DEVI * -3.0 IDEVl * -3 0084 

* 0085 

* 2. INPUTS - IXM...2) = OCT OOCOOOOOOOOl, 000000000002 0086 
» IYC1..J2) * OCT 000000000002, 000000000004 0087 

* IXBASE * OCT 000000000003 IDIF4 = 0 0088 
» USAGE - CALL XSMDFRC IX, IY, 2, IDIF2 ) 0089 

* CALL XSMDEVt IX, IXBASE, 2, IDEV2) 0090 

* CALL XSMDFRUX,IY%1,IDIF3) 0091 
» CALL XSMDFRt IX, IY,-1,IDIF4) 0092 

* CALL XSMDFR(IX,IY,2,IY) 0093 

* OUTPUTS - ID1F2 =* OCT 400000000003 IDEV2 = OCT 400000000003 0094 

* ID1F3 a OCT 400000000001 IDIF4 « 0 {NO OUTPUT CASE ) 0095 

* IY(l) * OCT 400000000003 0096 

* 0097 
» PROGRAM FOLLOWS BELOW 0098 
» 0099 

* 0100 

* NO TRANSFER VECTOR 0101 

HTR 0 XR4 0102 

BCI 1, SUMDFR 0103 

* PRINCIPAL ENTRY. SUMDFR {X,Y,LXY,SUMXMY> 0104 
SUMDFR LDQ FAD 0105 

CLA FSB 0106 

SETUP1 STO SUB1 0107 

CLA 2,4 0108 

ADD Kl A(Y)+1 0109 

STA SUB1 0110 

SETUP2 STQ ADD1 0111 

SXD SUMDFR-2,4 0112 

CLA* 2,4 XBASE OR Y( DUMMY ) 0113 

STO TEMP 0114 

Kl CLA 1,4 0tl5 

ADD Kl A(X)+1 0116 

STA ADD1 0117 

CLA* 3,4 LXY OR LX 0118 

TMI LEAVE 0119 

PDX 0,4 0120 

TXL LEAVE, 4,0 0121 

PXD 0,0 CLEAR AC 0122 

* LOOP 0123 
ADD1 NOP FAD **,4 ADD **,4 **=A(XI+1 0124 
SUB1 NOP FSB **,4 SUB **,4 FSB TEMPt SUB TEMPt 0125 

« **=ACY!+l 0126 

TIX ADD 1,4 1 0127 

* STORE RESULT 0128 

LXD SUMDFR-2,4 0129 

STO* 4,4 SUMXMY ETC 0130 

* EXIT 0131 
LEAVE LXD SUMDFR-2,4 0132 

TRA 5,4 0133 

* SECOND ENTRY. XSMDFRI IX*IY,LXY, ISMXMY ) 0134 
XSMDFR LDQ ADD 0135 

CLA SUB 0136 

TRA SETUP1 0137 

* THIRD ENTRY. SUMDEV ( X , XBASE , LX , SUMXMB ) 0138 
SUMDEV LDQ FAD 0139 

CLA FS8T 0140 

TRA SETUP3 0141 

* FOURTH ENTRY. XSMDEVC IX, IXBASE, LX, IS MX MB) 0142 
XSMDEV LDQ ADD 0143 

CLA SUBT 0144 

SETUP3 STO SUBl 0145 

TRA SETUP2 0146 

* CONSTANTS, TEMPORARIES 0147 
FAD FAD **,4 0148 
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FSB 


FSB 


**»4 




0149 


ADD 


ADD 


***4 




0150 


SUB 


SUB 


• *»A 




0151 


FSBT 


FSB 


TEMP 




0152 


SUBT 


SUB 


TEMP 




0153 


TEMP 


PZE 


••,*»,*• 


*XBASE OR IXBASE 


0154 




END 






0155 
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* SWITCH <FUNCTION) 9/4/64 LAST CARD IN DECK IS NO. 0083 

• FAP 0001 
•SWITCH 0002 

COUNT 100 0003 

LBL SWITCH 0004 

ENTRY SWITCH FUSENSE) 0005 

» 0006 

* 0007 

* ABSTRACT 0008 

* 0009 

* TITLE - SWITCH 0010 
» TEST THE CONDITION OF ANY SENSE SWITCH 0011 

• 0012 

• SWITCH IS A FUNCTION WHICH TESTS THE STATUS OF THE 0013 
» SENSE SWITCH WHOSE NUMBER IS THE ARGUMENT OF THE FUNCTION 0014 
» 0015 

• LANGUAGE - FAP FUNCTION (FORTRAN II COMPATIBLE) 0016 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME PLUS CONSOLE) 0017 

• STORAGE - 15 REGISTERS 0018 

* SPEED - ABOUT 22 MACHINE CYCLES 0019 
» AUTHOR - S. M. SIMPSON, MARCH 1964 0020 

* 0021 

• 0022 

« USAGE 0023 

» 0024 

• TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0025 

• AND FORTRAN SYSTEM ROUTINES - CNOT ANY) 0026 

* 0027 
» FORTRAN USAGE 0028 

* ZIFOFF = SWITCHFUSENSE) 0029 

• 0030 

* 0031 

* INPUTS 0032 

* 0033 
» I SENSE IS ANY INTEGER 0034 
« 0035 

* 0036 
» OUTPUTS 0037 

* 0038 

• ZIFOFF » 0.0 IF ISENSE IS LSTHN= 0 OR GRTHN- 7 0039 
» * 0.0 IF I SENSE = 1,2,3,4, 5, OR 6 AND THE 0040 

* CORRESPONDING SENSE SWITCH IS OFF. 0041 

• » 1.0 IF ISENSE = 1*2, 3,4,5, OR 6 AND THE 0042 

• CORRESPONDING SENSE SWITCH IS DEPRESSED (ON). 0043 

• 0044 

• 0045 

• EXAMPLES 0046 

* 0047 
» 1. THIS EXAMPLE ASSUMES ALL THE SENSE SWITCHES ARE OFF 0048 

* INPUTS - ZFOFFVC 1...10) = -99. , -99 . , . . . ,-99. 0049 
» USAGE - DO 10 I»l,10 0050 
» I SENSE = 1-2 0051 
» 10 ZFOFFV(I) * SW ITCHF ( I SENSE ) 0052 

# OUTPUTS - ZF0FFVH...10) = 0 . 0,0.0, 0.0 0053 
» 0054 
» 2. THIS EXAMPLE ASSUMES ALL THE SENSE SWITCHES ARE ON (OEPRfSSED) 0055 

* INPUTS - SAME AS EXAMPLE 1. 0056 

* USAGE - SAME AS EXAMPLE 1. 0057 

♦ OUTPUTS - ZF0FFV11...10) « 0. 0,0.0, 1 .0, 1 .0, 1 .0, 1 .0, 1.0, 1.0^0.0* 0. 0 0058 
» 0059 
» 0060 

* PROGRAM FOLLOWS BELOW 0061 

• 0062 

• NO TRANSFER VECTOR 0063 
» 0064 

BCI 1, SWITCH 0065 

• 0066 

• ONLY ENTRY. SWITCH F (ISENSE) 0067 
» 0068 
SWITCH TMI PXD 0069 

TZE PXD 0070 

ARS 18 0071 

SUB K7 0072 

TPL PXD 0073 

ADD K119 GIVES 112 ♦ ISENSE 0074 



• *••**•**•*•*»**•*•.«»*«* 

* SWITCH * 

(PAGE 2) 



PROGRAM LISTINGS 



« SWITCH * 
4#* #*#»#*#**»#»** #*»»*#♦ 

(PAGE 2) 





STA 


PSE 




0075 




CLA 


K1L 




0076 


PSE 


PSE 


*# 


** = 113,114,... (161,162,... OCTAL) 


0077 


PXD 


PXO 


0,0 




0078 




TRA 


1,4 




0079 


K7 


PZE 


7 




0080 


K119 


PZE 


119 


119 = 112+7 


0081 


K1L 


DEC 


1.0 




0082 




END 






0083 
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TAMVL (SUBROUTINE) 9/4/64 LAST CARD IN DECK IS NO, 0188 



* 


FAP 








0001 


•TAMVL 








0002 




COUNT 


200 






0003 




LBL 


TAMVL 






0004 




ENTRY 


TAMVL tX, LX, LAVG, AVGL) 






0005 




ENTRY 


TAMVR IX, LX, LAVG, AVGR) 






0006 


* 










0007 


• 










0008 


• 




ABSTRACT • 






0009 


* 










0010 


• 


TITLE - TAMVL WITH SECONDARY ENTRY TAMVR 






0011 


» 


TRIANGULAR AVERAGING, MOVING LEFT OR RIGHT END 






0012 


• 










0013 


• 




TAMVL COMPUTES 






0014 


• 










0015 


* 




i LX 






0016 


• 




AVGL ( I ) = ' SUM X{ J) FOR 1*1. 


..LAVG 


0017 


» 




LX-I+1 J=I 






0018 


• 










0019 


• 




GIVEN XU...LX), LX AND LAVG. 






0020 


• 










0021 


* 




TAMVR HAS THE SAME INPUTS BUT COMPUTES 






0022 


» 










0023 


• 




1 LX-I+1 






0024 


• 




AVGR(I) = SUM XU) FOR 1 = 1. 


..LAVG 


0025 


• 




LX-I+1 J=l 






0026 


• 










0027 


* 










0028 


» 


LANGUAGE 


- FAP SUBROUTINES i FORTRAN- I I COMPATIBLE) 






0029 


* 


EQUIPMENT 


- 709,7090,7094 (MAIN FRAME ONLY) 






0030 


• 


STORAGE 


- 63 REGISTERS 






0031 


* 


SPEED 


- EITHER ENTRY TAKES ABOUT 






0032 


» 




80 ♦ 8.4*LX + 41.8*LAVG MACHINE CYCLES ON 


THE 


7090 


0033 


• 


AUTHOR 


- S.M. SIMPSON, JULY 1964 






0034 


* 










0035 


« 










0036 


» 




USAGE 






0037 


• 










0038 


* 


TRANSFER VECTOR CONTAINS ROUTINES - CNOT ANY) 






0039 


• 


AND 1 


FORTRAN SYSTEM ROUTINES - (NOT ANY) 






0040 


* 










0041 


• 


FORTRAN USAGE 






0042 


• 


CALL TAMVL ( X t LX, LAVG, AVGL) 






0043 


* 


CALL TAMVR(X, LX, LAVG, AVGR ) 






0044 


• 










0045 


• 










0046 


• 


INPUTS TO 


BOTH TAMVL AND TAMVR 






0047 


« 










0048 


• 


XU) 


1=1. ..LX IS A FLOATING VECTOR. 






0049 


• 










0050 


• 


LX 


MUST EXCEED ZERO. 






0051 


• 










0052 


* 


LAVG 


IS DESIRED NUMBER OF OUTPUT AVERAGES. 






0053 


• 




MUST EXCEED ZERO AND BE LSTHN= LX, 






0054 


* 










0055 


• 










0056 


• 


OUTPUTS 


STRAIGHT RETURN WITH NO OUTPUTS IF LX OR 


LAVG 


ILLEGAL 


0057 


• 










0058 


• 


AVGL ( I ) 


1=1. ..LAVG IS OUTPUT FROM TAMVL AS DEFINED IN 


ABSTRACT 


0059 


• 










0060 


« 


AVGR ( 1 3 


1=1. ..LAVG IS OUTPUT FROM TAMVR AS DEFINED IN 


ABSTRACT 


0061 


• 










0062 


• 










0063 


• 


EXAMPLES 








0064 


• 










0065 


* 


1. TESTING 


EXTREMAL RANGES OF LX AND LAVG 






0066 


• 


INPUTS 


- XU...3) = l.,2.,3. 






0067 


» 




AVGL( 1...3, 1...3, 1...3) = -9. ,-9.,..* 






0068 


• 




AVGR( 1...3, 1...3, 1...3) = -9. ,-9.,... 






0069 


• 


USAGE 


DO 10 LX=1,3 






0070 


* 




DO 10 LAVG=1,LX 






0071 


* 




CALL TAMVLIX, LX , LAVG, AVGL ( 1, LAVG, 


LXS) 




0072 


* 




10 CALL TAMVRIX, LX , LAVG, AVGRU, LAVG, 


LXJM 




0073 
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• OUTPUTS - AVGL(1..*3, 1...3,1) * 1.0,-9. ,-9. , ,~9. ,-9. ^.ti, 0074 

• -9. ,-9., -9. 0075 

* AV6L(U..3,1...3,2) = i.5,-9. ,-9;,, 1*5,2.04-9. 0076 
» -9., -9. ,-9. 0077 

* AV6L(1...3,1...3,3) * 2.0,-9. ,-9*, ,2. 0,2. 54-9. 0078 

• 2.0,2.5,3.0 0079 

* AVGR(U..3»1*..3,1> « 1.0,-9.,-9.,,-9.*-9.<-9.,J, 0080 
» -9., -9., -9. 0081 

• AV6R(K..3,i...3,2) * 1. 5, -9. ,-9.,, 1.5, 1.01-9. *(* 0082 

* -9. ,-9. ,-9. 0083 

• AVGR(1...3,1*..3,3> * 2. 0,-9. ,-9. f , 2.0*1.54-9.,*, 0084 

* 2.0,1.5,1.0 0085 

* 0086 
» 2. ILLEGAL USAGES 0087 
» INPUTS - SAME AS EXAMPLE 1. 0088 
» USAGE - CALL TAMVL<X,-1, 2,AVGL) 0089 
» CALL TAMVRIX, 0, 2, AVGR) 0090 

• CALL TAMVUX, 3,-l t AVGL) 0091 

• CALL TAMVRIX, 3, 0,AVGR) 0092 

• CALL TAMVLIX, 3, A, AVGL ) 0093 

♦ OUTPUTS - AVGL « AVGR = -9. 0094 

* 0095 
» 0096 

* PROGRAM FOLLOWS BELOW 0097 
» 0098 

• NO TRANSFER VECTOR 0099 
» 0100 

HTR 0 XR2 0101 

HTR 0 XR4 0102 

BCI 1 , TAMVL 0103 

♦ 0104 

* PRINCIPAL ENTRY. TAMVL( X, LX, LAVG, AVGL) 0105 
» 0106 

TAMVL STZ ZFTAML SET SWITCH = 0 0107 

TRA MERGE 0108 

* 0109 

• SECONDARY ENTRY. TAMVR( X, LX, LAVG, AVGR) 0110 
» 0111 

TAMVR CLA* 2,4 SET 0112 

ARS 18 SWITCH 0113 

AOD Kl EQUAL 0114 

STO ZFTAML LX+1 0115 

MERGE SXD TAMVL-3,2 0116 

SXO TAMVL-2,4 0117 

* 0118 

• SET AODRESSES, LAVG, LX, AND LOOP FOR TAMVL OR TAMVR 0119 

* 0120 
CLA 1,4 A<X) 0121 
ADD Kl A(Xm 0122 
STA FAD 0123 
SUB ZFTAML MINUS 0 OR MINUS LX+1 0124 
STA FSB 0125 
CLA 4,4 A(AVG) AVG » AVGL OR AVGR 0126 
ADD Kl A(AVG)+l 0127 
STA STQ 0128 
CLA* 3,4 LAVG 0129 
STD TXL 0130 
TMI LEAVE 0131 
TZE LEAVE 0132 
CAS* 2,4 AGAINST LX 0133 
TRA LEAVE NG 0134 
NOP OK 0135 
CLA* 2,4 OK, WORK ON LX 0136 
TMI LEAVE 0137 
POX 0,2 LX TO XR2 FOR LOOP AT FAD 0138 
TXL LEAVE, 2,0 0139 
LRS 18 0140 
ORA OCTK 0141 
FAD OCTK 0142 
STO LENGTH LX FLOATED TO LENGTH 0143 
AXT 1,4 ANTICIPATE TAMVL 0144 
ZET ZFTAML 0145 
AXT -1,4 CHANGE FOR TAMVR 0146 
SXD TXI,4 0147 

* 0148 
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» NOW FORM SUM (FROM 1*1 TO LX) OF XII) IN AC 0149 

* THE MAJOR LOOP AT CLA WILL SUBTRACT OFF ONE END 0150 

* VALUE OF X FOR EACH ADDITIONAL OUTPUT 0151 

* 0152 
CLM 0153 

FAD FAD *»*2 »» = A(X)+1 0154 

TIX FAD, 2,1 (LEAVES XR2 = 1) 0155 

AXT 0,4 XR4 » 0 0156 

TRA STO 0157 

* 0158 
» LOOP, (XR2,XR4) = { 1 ,0) , ( 2 , 1 ) , ( 3, 2) , . . . OR ( 1,0) , ( 2,- 1) , 13,-21 * i 0159 

* 0160 
CLA CLA TEMP 0161 
FSB FSB **,4 ** = A(X)+1 (TAMVL) OR ACX)-fcX (TAMVR) 0162 
STO STO TEMP 0163 

FDP LENGTH 0164 

STQ STQ **,2 ** = A(AVG)+l 0165 

CLA LENGTH C166 

FSB K1L 0167 

STO LENGTH 0168 

TXI TXI *+l,4,«* ** = 1 (TAMVL) OR -1 (TAMVR) 0169 

TXI *+l,2,l 0170 

TXL TXL CLA,2,»* *» = LAVG 0171 

* 0172 
« EXIT 0173 

* 0174 
LEAVE LXD TAMVL-3,2 0175 

LXD TAMVL-2,4 0176 

TRA 5,4 0177 

* 0178 

* CONSTANTS, TEMPORARIES 0179 
« 0180 

Kl PZE 1 0181 

K1L DEC 1.0 0182 

OCTK OCT 233000000000 0183 

ZFTAML PZE ***0,0 ♦* * 0 IF TAMVL, * LX+1 IF TAMVR 0184 

TEMP PZE ♦*,«*,*# SUMS OF X(I) 0185 

LENGTH PZE *»,*«,#* * LX FLOATED, THEN REDUCED SUCCESSIVELY 0186 

» BY 1.0 0187 

END 0188 
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* TIMA2B (7094) (iSUBROUTINE) 9/9/64 LAST CARD IN DECK IS NO. 0257 

* FAP 0001 
•TIMA2B (7094) 0002 

COUNT 200 0003 

LBL TIMA28 0004 

ENTRY TIHA2B ( LOCA, LOCB, MINACC, SECS ) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - TIMA2B (7094) 0009 

* REAL TIME, TO SPECIFIED ACCURACY, OF GIVEN PROGRAM RANG! 0010 

* 0011 

* TIMA2B ASSUMES THAT A PROGRAM EXISTS AT MACHINf ADDRESS 0012 

* LOCA WHICH WILL EVENTUALLY SEND CONTROL TO LOCi, AND 0013 
« WHICH MAY BE OPERATED REPETITIVELY* TIMA2B DETERMINES 0014 
« THE TIME IN SECONDS, TO A SPECIFIED ACCURACY, THAT ONE 0015 
» OPERATION OF THE PROGRAM REQUIRES. THE TIME INCLUDES THE 001b 

* TIME OF THE OPERATION AT LOCA BUT NOT THAT OF THE 0017 

* OPERATION AT LOCB. THE AC AND MQ ARE LEFT AS PRODUCED BY 0018 
» THE PROGRAM. 0019 

* 0020 

* CONSTANTS USED IN THE PRESENT VERSION PERTAIN TO THE 0021 

* 7094. THE NECESSARY MODIFICATIONS FOR THE 7090 ARE 0022 

* INDICATED IN THE OECK. 0023 

* 0024 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN- I I COMPATIBLE) 0025 

* EQUIPMENT - 7090 OR 7094 { MAIN FRAME PLUS INTERVAL TIMER) 0026 

* STORAGE - 124 REGISTERS 0027 
» SPEED - TAKES SOMEWHAT LESS THAN 00^8 

* MAX(2*MlNACC/60., SECS, 0029 

* MINACC*{S£CS+.000048)/( SECS*60.) ) 0030 

* SECONDS ON THE 7094 MOD 1, WHERE SECS IS THE 0031 

* MEASURED TIME BETWEEN LOCA AND LOCB IN SECONDS, 0032 

* AND WHERE THE USER SPECIFIES THAT THE TIMING ERROR 0033 
» SHALL NOT EXCEED ONE PART IN MINACC PARTS. 0034 

* AUTHOR - S.M. SIMPSON JR. AND R.A. WIGGINS 0035 

* 0036 

* USAGE 0037 

* 0038 
» TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0039 
» AND FORTRAN SYSTEM ROUTINES - (NONE) 0040 
» 0041 

* FORTRAN USAGE 0042 
» CALL TIMA2B(L0CA, LOCB, MINACC, SECS) 0043 

* 0044 

* INPUTS 0045 

* 0046 

* LOCA IS MACHINE ADDRESS (AS FORTRAN— 1 1 INTEGER) OF FIRST 0047 
» INSTRUCTION IN PROGRAM TO BE TIMED. 0048 

* 0049 

* LOCB IS MACHINE ADDRESS TO WHICH CONTROL IS SENT AFTER 0050 
» PROGRAM. IT EQUALS 1 + MACHINE ADDRESS OF LAST 0051 

* INSTRUCTION IF LAST INSTRUCTION IS NOT A TRANSFER* 0052 

* 0053 
» MINACC SPECIFIES THAT THE TIMING ERROR SHALL NOT EXCEED ONE PART 0054 

* IN MINACC PARTS. 0055 

* MUST EXCEED 0 0056 

* 0057 
» OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF MINACC IS ILLEGAL* 0058 

* 0059 

* SECS IS THE REQUIRED TIME IN FLOATING POINT SECONDS* 0060 

* 0061 

* THE ACCUMULATOR AND MULTIPLIER QUOTIENT REGISTERS WILL HAVE VALUES 0062 
« AS LEFT BY THE PROGRAM WHEN CONTROL ARRIVES AT LOCB* 0063 

* 0064 
» WARNING - IF THE PROGRAM CONTAINS OUTPUT OR INPUT 0065 
« INSTRUCTIONS THEY WILL BE OPERATED REPETITIVELY IF 0066 
» NECESSARY TO ACHIEVE THE REQUIRED ACCURACY* 0067 

* 0068 
« EXAMPLES 0069 
» 0070 
« I* INPUTS - X(l...l001) = OCT 053400000000. THIS IS THE MACHINE 0071 

* INSTRUCTION LXA , WHICH ALWAYS TAKES 2 CYCLES ON THE 0072 

* 7090, 7C94. 0073 
« LOCB^XLCCF(X), L0CA1=L0CB-1000, LOCA2=LOCB-10O, 0074 
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L0CA3=L0CB-10, L0CA4=L0CB-2. 
PROGRAMS OF LENGTH 1000, 100, 
RESPECTIVELY. MINACC = 100 



THESE WILL DEFINE 4 
10, AND 2 INSTRUCTIONS 



USAGE 



OUTPUTS 



CALL TIMA2B(LGCA1,L0CB,MINACC,SECS1) 

CALL TIMA2B(L0CA2,L0CB,MINACC,SECS2) 

CALL TIMA2B(L0CA3,L0CB,MINACC,SECS3) 

CALL TIMA2B(L0CA4, LOCB, MINACC, SECS4 ) 

SECS1..*SECS4= .00400 .000400 .0000400 .00000800ION 7094) 

= .00436 .000436 .0000436 .00000872fON 7090) 

THE ACTUAL RESULTS SHOULD DEVIATE FROM THESE ANSWERS 

BY NO MORE THAN 1 PERCENT. 



• PROGRAM FOLLOWS BELOW 



THE CONSTANTS KC2MC AND KLUP BELOW PERTAIN TO THE 7094 
FOR THE 7090 THEY SHOULD READ 



KC2MC 
KLUP 



DEC 
DEC 



7645.259 
27.0 



NO. MACH. CYCLES PER COUNT (7090) 
NO. MACH. CYCLES IN L09P CONTROL 
(7090) 



* NO TRANSFER VECTOR 



HTR 
HTR 
HTR 
BCI 

> ONLY ENTRY. 
riMA2B SXD 

SXD 
SXD 
STO 
STQ 

* CHECK MINACC 
CLA* 
TMI 
TZE 

► OK, FLOAT IT 

ARS 
STO 
ORA 
FAD 
STO 
FAD 
STO 



0 XR1 
0 XR2 
0 XR4 
1,TIMA2B 

TIMA2B(*L0CA,L0CB,MINACC,SECS) 

TIMA2B-2,4 

TIMA2B-3,2 

TIMA2B-4,! 

AC 

MQ 

(SHOULDNT EXCEED 1000) 
3,4 MINACC 
LEAVE 
LEAVE 

18 

MINACX 

OCTK 

OCTK 

MINACC 

ONE 

MINAC1 



• THEN SET UP LINKAGE TO LOCA AND BACK FROM LOCB 



CLA* 

ARS 

STA 

CLA* 

ARS 

STA 

CLA* 

STO 

CLA 

STOXEC STO 
» SET KLUP * 
» SET KLUP * 
CLA 
ANA 
SSM 
ADD 
ORA 
FAD 
STO 



1,4 

18 

TRAOUT 

2,4 

18 

STOXEC 
STOXEC 
SAVNXT 
TRABAK 



LOCA 



LOCB 



(ORIGINAL CONTENTS OF LOCB) 



(XEC TRABAK) 
** ** » LOCB 

23. IF ADDRESS(LOOP) IS ODD 
24* IF ADDRESSILOOP) IS EVEN 
TRALUP 
Kl 



K24 
OCTK 
OCTK 
KLUP 

» CLEAR THE LOOPS COUNTER 

STZ STZ NL0OPS 
* SET INITIAL TIME 

CLA 5 

STO BEGIN 
» LOOP BEGINS 

» RESTORE XRS, AC, MQ, BEFORE ENTERING 
LOOP LXD TIMA2B-2,4 ADDS 2 CYCLES TO KLUP 

LXD TIMA2B-3,2 ADOS 2 CYCLES TO KLUP 



ADDS 0 CYCLES TO KEDGE 
ADDS 2 CYCLES TO KEDGE 



0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
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LXO 


TIMA2B~4,1 


ADDS 


2 


CYCLES 


TO 


KLUP 


0150 


CLA 


AC 


ADDS 


2 


CYCLES 


TO 


KLUP 


0151 


LDQ 


MQ 


ADDS 


2 


CYCLES 


TO 


KLUP 


0152 


TRAOUT TRA 


*» **-LOCA 


ADDS 


1 


CYCLE 


TO 


KLUP 


0153 


• 














0154 


♦TRABAKTRA 


BACK 


ADDS 


1 


CYCLE 


TO 


KLUP 


0155 


* 














0156 


BACK STO 


ACAFTR 


ADDS 


2 


CYCLES 


TO 


KLUP 


0157 


CLA 


NLOOPS 


AODS 


2 


CYCLES 


TO 


KLUP 


0158 


ADD 


Kl 


ADDS 


2 


CYCLES 


TO 


KLUP 


0159 


STO 


NLGOPS 


ADDS 


2 


CYCLES 


TO 


KLUP 


0160 


CLA 


5 


ADDS 


2 


CYCLES 


TO 


KLUP 


0161 


SUB 


BEGIN 


ADDS 


2 


CYCLES 


TO 


KLUP 


0162 


CAS 


MINACX 


ADDS 


2 


CYCLES 


TO 


KLUP 


0163 


NOP 














0164 


TRA 


LUPOVR 












0165 


TRALUP TRA 


LOOP 


ADDS 


i 


CYCLES 


TO 


KLUP 


0166 


LUPOVR STQ 


MQAFTR 












0167 



THEN FORM DIFFERENCE OF 
WE HAVE 

KC2MC*C0UNTD * KEDGE + 
WHERE KC2MC * NO. MACH 
COUNTD = TERMINAL 
KEDGE = NO. MACH 
KLUP « NO. MACH 
X = NO. MACH 



COUNTS AND CHECK IF ADEQUATE 

NLOOPS*(X+KLUP) 
INE CYCLES/COUNT 

COUNT MINUS INITIAL COUNT 
INE CYCLES IN LOOP EDGE EFFECT 
INE CYCLES INSIDE LOOP EXCLUSIVE OF PROGRAM 
INE CYCLES IN PROGRAM 



» THUS THE NUMBER OF COUNTS SPENT INSIDE THE PROGRAM IS 



NCIP 



« (NLC0PS*X)/KC2MC 

= COUNTD - (KEDGE + NL00PS*KLUP ) /KC2MC 



ENUF 



0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 



' MUST EXCEED MINACC 




0181 








0182 


I NCIP 






0183 


ORA 


OCTK 




0184 


FAD 


OCTK FLOATING COUNTD 




0185 


STO 


COUNTD 




0186 


CLA 


NLOOPS 




0187 


ORA 


OCTK 




0188 


FAD 


OCTK 




0189 


STO 


FNLUPS 




0190 


XCA 






0191 


FMP 


KLUP TIMES KLUP 




0192 


FAD 


KEDGE PLUS KEDGE 




0193 


FDP 


KC2MC OVER KC2MC) 




0194 


XCA 






0195 


CHS 






0196 


FAD 


COUNTD NCIP=COUNTD MINUS DITTO 




0197 


STO 


NCIP 




0198 


CAS 


MINACC 




0199 


NOP 






0200 


TRA 


ENUF ENOUGH 




0201 


AN INADEQUATE COUNT WE COMPUTE A REASONABLE MINACC AND 


TRY AGAIN 


0202 


FSB 


ONE 




0203 


STO 


NCIP 




0204 


LDQ 


KC05 




0205 


TLQ 


*+2 




0206 


STQ 


NCIP 




0207 


CLA 


MINAC1 




0208 


FDP 


NCIP 




0209 


FMP 


COUNTD 




0210 


UFA 


OCTK 




0211 


ANA 


0CTK1 




0212 


ADD 


Kl 




0213 


STO 


MINACX 




0214 


TRA 


LOOP 




0215 


ADEQUATE 


COUNT, RESTORE LOCB, CONVERT NCIP TO SECONDSt 


EXIT 


0216 


LXD 


TIMA28-2,4 




0217 


CLA 


SAVNXT 




0218 


STO* 


STOXEC RESTORE LOCB 




0219 


LDQ 


NCIP 




0220 


FMP 


KC2S KC2S » NO. SECONDS PER COUNT 




0221 


FDP 


FNLUPS SECS = (C0UNTD*KC2S)/NL00PS 




0222 


STQ* 


4,4 




0223 


LXD 


TIMA2B-2,4 




0224 
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LXD 


TIMA2B-3 t 2 






0225 




LXD 


T I MA2B-4 v I 






0226 




CLA 


ACAFTR 






0227 




LDQ 


MQAFTR 






0228 




TRA 


5 f 4 






0229 


» CONSTANTS 








0230 


ONE 


DEC 


I. 






0231 


Kl 


PZE 


1 






0232 


K24 


PZE 


24 






0233 


OCTK 


OCT 


233000000000 






0234 


OCTKl 


OCT 


000777777777 






0235 


TRABAK 


TRA 


BACK 






0236 


KC2MC 


DEC 


8333*3333 


= NO. MACHINE CYCLES PER CLOCK 


COUNT (7094) 


0237 


KC2S 


DEC 


•016666667 


* NO. SECONDS PER CLOCK COUNT 


( 1/607 


0238 


KC05 


DEC 


• 05 






0239 


KEDGE 


DEC 


86. 0 


« APPROXIMATE NUMBER CYCLES IN 


LOOP EDGES 


0240 


* 






40. LSTHN KEDGE LSTHN 134. 




0241 


KLUP 


DEC 


0. 


- NO. CYCLES IN LOOP CONTROL 


I EMPIRICAL) 


0242 


* VARIABLES 








0243 


SAVNXT 


PZE 


** f *« » *» 


INITIAL CONTENTS OF LOCB 




0244 


NLOOPS 


PZE 


• * 


INITIAL SET = 0 




0245 


FNLUPS 


PZE 


**,«»,•« 


FLTG. NLOOPS 




0246 


COUNTO 


PZE 


**,•-*,#* 


FLTG. COUNT DIFFERENCE 




0247 


NCIP 


PZE 


•»,**,*• 


FLTG. COUNT INSIDE PROGRAM 




0248 


MINACC 


PZE 




FLTG. MINACC 




0249 


MINACX 


PZE 


** 9 *» , 4* 


FXD. MINACC 




0250 


MINAC1 


PZE 


«*,**,#* 


FLTG. MINACC+l 




0251 


BEGIN 


PZE 


♦ » y »♦ , #* 


INITIAL CLOCK COUNT (FIXED) 




0252 


AC 


PZE 


• * y «*, ♦ * 


ORIGINAL AC 




0253 


MQ 


PZE 


**,**, • * 


ORIGINAL MQ 




0254 


ACAFTR 


PZE 


•* ,♦*,#» 


AC AFTER PROGRAM 




0255 


MQAFTR 


PZE 
END 


** y »• 9 f # 


MQ AFTER PROGRAM 




0256 
0257 



*»•»*«*•**••**•••**•**** 

* TIMSUB * 
###»*»*#*»»»**#♦♦♦*#**#♦ 



PROGRAM LISTINGS 



**»***••••»#«**»*»•****» 

* timsub * 
«*«#**»•*#*••#*»*****•** 



* TIMSUB ( SUBROUTINE) 9/8/64 LAST CARD IN DECK IS NO* 0449 

* FAP 0001 
♦TIMSUB 0002 

COUNT 250 0003 

LBL TIMSUB 0004 

ENTRY TIMSUB tMINACC, SECS ) 0005 

ENTRY INTMSB 0006 

* 0007 

* ABSTRACT-** — — 0008 

» 0009 

* TITLE - TIMSUB 0010 

* FIND OPERATION TIME OF NEXT SUBROUTINE TO GIVEN ACCURACY 0011 

* 0012 

* TIMSUB IS CALLED JUST PRIOR TO A CALL SUBROUTINE 0013 
» STATEMENT, OF FORM CALL SUBRUI A, B, . ..Z ) , OR TO A FUNCTION 0014 

* STATEMENT, OF FORM X = SOMEFi A, B, ••*,£)• THE SUBROUTINE 0015 

* OR FUNCTION SHOULD BE CAPABLE OF BEING CALLED IN A 0016 

* REPETITIVE LOOP. TIMSUB THEN OPERATES THE SUBROUTINE OR 0017 

* FUNCTION ENOUGH TIMES TO MEASURE THE REAL TIME IT TAKES 0018 
« (IN SECONDS ) TO A SPECIFIED ACCURACY. THE TIME RESULTING 0019 
» IS MEASURED FROM THE FIRST INSTRUCTION IN THE SUBROUTINE 0020 

* THROUGH ITS FINAL RETURN TRANSFER. TIMSUB LEAVES THE AC 0021 

* AND MQ WITH VALUES AS INDUCED BY THE SUBROUTINE OR 0022 

* FUNCTION, AND RETURNS CONTROL JUST BEYOND THE CALL SUBRU 0023 

* COR X^SOMEF) STATEMENT. 0024 

* 0025 

* INTMSB IS USED FOR CERTAIN SUBROUTINES i SAY WHERE 0026 
« OUTPUTS REPLACE INPUTS) WHICH REQUIRE AN INPUT SETUP 0027 

* SEQUENCE BEFORE EVERY USAGE. IN SUCH CASES TIMING IS 0028 

* PERFORMED AS ABOVE EXCEPT 1 ) IMMEDIATELY PRECEEDING THE 0029 

* CALL TIMSUB STATEMENT THE INPUT SETUP SEQUENCE MUST 0030 

* OCCUR, AND 2) IMMEDIATELY PRECEEDING THE INPUT SETUP 0031 

* SEQUENCE THERE EXISTS A CALL INTMSB STATEMENT. THE 0032 
» COMBINED SEQUENCE OF INPUT SETUP PLUS CALL SUBRU (OR 0033 

* X=SOMEF) SHOULD BE CAPABLE OF REPETITIVE OPERATION. 0034 

* 0035 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN- I I COMPATIBLE) 0036 
» EQUIPMENT - 709,7090, OR 7094 (MAIN FRAME PLUS SOME FORM OF REAL TIME 0037 

* CLOCK) 0038 

* THE TIMING IS PERFORMED BY SUBROUTINE TIMA2B. A 0039 

* DIFFERENT VERSION OF TIMA2B MUST BE USED FOR EACH 0040 

* MACHINE. AS OF SEPTEMBER, 1963 NO VERSION OF TIMA2B 0041 

* EXISTS FOR THE 709. 0042 
» STORAGE - 229 REGISTERS 0043 
» SPEED - IF WE LET TMSUB BE THE TIME IN SECONDS TAKEN BY THE 0044 

* SUBROUTINE AND TMSET BE THE TIME IN SECONDS TAKEN BY 0045 

* THE SETUP SEQUENCE, THEN TTIM, THE TIME IN SECONDS 0046 

* TAKEN BY TIMSUB TO OBTAIN THE ESTIMATE IS APPROXIMATED, 0047 
» IN THE CASE OF THE 7094 MOD 1, BY 0048 

* 0049 

* TTIM = MINACC*(T IME1+TIME2) 0050 

* 0051 
« WHERE TIME1 = MAXU0375, TMSUB, 0052 

* ( TMSUB+.000048)/! 53. 3 3* TMSUB) ) 0053 
» AND TIME2 » MAX(. 00469, TMSET, 0054 

* (TMSET*. 000048)/(426.67*TMSET) ) 0055 

* 0056 
» IF TMSUB*60. GRTHN= MINACC, OR 0057 

* IF TMSUB/(8.*TMSET) GRTHN= 1. 0058 

* 0059 

* IF NEITHER OF THESE CONDITIONS HOLD, THEN TTIM IS 0060 

* APPROXIMATED BY 0061 
» 0062 
» TTIM LSTHN- M INACC< T IME 1*( U ♦( TMSUB + TMSET ) /TMSUB ) + 0063 

* TIME2*( l.+TMSET/TMSUBH 0064 
» 0065 

* WHEN INTMSB IS NOT USED, THE MINIMUM TMSET IS 0066 

* .000028 SECONDS. IT MAY BE GREATER THAN THIS $F THE 0067 

* SUBROUTINE CALLED HAS SUBSCRIPTED ARGUMENTS. 0068 

* 0069 

* AUTHOR - S.M. SIMPSON JR. AND R.A. WIGGINS 0070 
» 0071 

* USAGE 0072 

* 0073 

* TRANSFER VECTOR CONTAINS ROUTINES - TIMA2B 0074 
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» AND FORTRAN SYSTEM ROUTINES - i NONE) 0075 

* 0076 
» FORTRAN USAGE FOR ROUTINES NOT REQUIRING INPUT SETUP FOR EACH CALL 0077 

* 0078 
» CALL TIMSUB(MINACCSECS) 0079 

* CALL SUBRU(A,Bt. ..,Z) 0080 
» OR 0081 

* CALL TIMSUB(MINACCSECS) 0082 

* X « SOMEF { A, B , . . . t Z) 0083 
» 0084 

* FORTRAN USAGE FOR ROUTINES REQUIRING INPUT SETUP BEFORE EACH CALL 0085 
» 0086 

* CALL INTMSB 0087 

* (INSERT HERE PROGRAM TO SET UP INPUTS FOR SUBRU OR SOMEF) 0088 
» CALL TIMSUBtMINACCSECS) 0089 

* CALL SUBRU(A,B, ...,Z) OR X = SOMEF(A,B,...,Z) 0090 

* 0091 

* INPUTS 0092 

* 0093 

* MINACC SPECIFIES THAT THE TIMING ERROR SHOULD NOT EXCSEO ONE 0094 

* PART IN MINACC PARTS. 0095 

* MUST EXCEED 0 0096 

* 0097 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF MINACC IS ILLEGAL* 0098 

* 0099 
» SECS IS THE DESIRED TIME. 0100 
» 0101 
« IF THE SUBROUTINE OR FUNCTION HAS ANY OUTPUTS THEY WILL 0102 

* BE THE SAME AS IF THE CALL TIMSUB STATEMENT WERE OMITTED. 0103 

* 0104 

* EXAMPLES 0105 

* 0106 

* SUPPOSE SUBROUTINE LXAZ IS THE FOLLOWING PROGRAM REQUIRING 100 0107 

* MACHINE CYCLES 0108 

* 0109 

* * FAP 0110 
» ' COUNT 50 0111 
» LBL LXAZ 0112 

* ENTRY LXAZ 0113 

* LXAZ LXA 0*0 0114 
» LXA OtO 0115 

* . 0116 
» . 0117 

* . 0118 

* ETC FOR A TOTAL OF 48 LXA 0,0 INSTRUCTIONS 0119 

* . 0120 

* . 0121 

* . 0122 

* LXA 0,0 0123 

* XEC »+l 0124 

* XEC *+l 0125 

* TRA 1,4 0126 
» 0127 
» 0128 

* 1. USAGE - CALL T I MSUB ( 100 , SECS ) 0129 
» CALL LXAZ 0130 
» OUTPUTS - SECS = .000218 (7090) OR .000200 (7094) WITH ERROR LESS 0131 
» THAN .000002 0132 

* 0133 

* 2. USAGE - CALL INTMSB 0134 
» X=4 0135 

* Y=C0SF(3.) 0136 

* CALL TIMSUB( 100, SECS) 0137 

* CALL LXAZ 0138 

* OUTPUTS - SAME AS EXAMPLE 1. 0139 

* 0140 

* 3. USAGE - CALL T IMSUB( 100, SECS ) 0141 

* X « SQRTF ( 9. 8696044 ) 0142 
» 0143 

* OUTPUTS - X * 3.1415627 AND SECS = .000168 (APPROXIMATELY) 0144 

* 0145 

* PROGRAM FOLLOWS BELOW 0146 

* 0147 

* 0148 

* TRANSFER VECTOR CONTAINS T I M A2B ( LOCA, LOCB, M INACC, SECS ) 0149 
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XR1 
XR2 
XR4 



RELATIVE 
TO 
TIMSUB 



HTR 0 

HTR 0 

HTR 0 

BCI 1, TIMSUB 

PRINCIPLE ENTRY, T1MSUB( MINACC, SECS ) 
(STRAIGHT RETURN IF UNDER CONTROL OF INTMSB) 
MSUB SXD TIHSUB-2,4 

SXD TIMSUB~3,2 

SXD TIMSU8~4,1 

fill ZIFINT 

TRA 3,4 



* PRELIMINARY NOTATION FOR TIMSUB AND INTMSB 



TI 



TTSUB TTR SUB 
TTINT TTR INTMSB 
TTTIM TTR TIMSUB 



• TSXINT TSX TTI NT,4 



TSXTIM TSX 
TSX 
TSX 



TSXSUB TSX 
TSX 



TSX 



TSXRGN TSX 
FINISH 



TTTIM,4 

A(MINACC),0 

A($ECS),0 



TTSUB, 4 
A(ARG1),0 
A( ARG2) ,0 



A( ARGN) ,0 



(MAY BE MISSING) 

(ARBITRARY AREA) 
(MAY BE MISSING) 
(INPUT SETUP AREA) 



(FORTRAN INPUT SETUP AREA) 



(ARBITRARY AREA) 



* CONTINUE WITH TIMSUB ENTRY 



SXA 


BEGIN, 1 


SXA 


BEGIN+1,2 


PXA 


0,4 


PAC 


0,1 


TXI 


*+ I , i , 3 


SXA 


START, 1 


SXD 


DSTART , 1 


TRA 


SETUP 


ID ENTRY. INTMSB 


HTR 


0 


HTR 


0 


HTR 


0 


SXD 


INTMSB-1,4 


SXD 


INTMSB-2,2 


SXD 


INTMSB-3,1 


SXA 


BEGIN, 1 


SXA 


BEGIN+1,2 


CN INTMSB SWITCH 


STZ 


ZIFINT 


PXA 


0,4 


PAC 


0,1 


TXI 


♦♦1,1,1 


SXA 


START, 1 


SXD 


DSTART , 1 


DOWN 


THE TSX X*4»S 


TSX 


TSX4SC1 


TXI 


•♦1,4,-1 


CLA 


0,4 


STA 


♦♦1 


CAL 


♦ * 


LAS 


TTRTIM 



XR1 RELATIVE 
XR2 TO 
XR4 INTMSB 



PICK UP THE TTR 



0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
0191 
0192 
0193 
0194 
0195 
0196 
0197 
0198 
0199 
0200 
0201 
0202 
0203 
0204 
0205 
0206 
0207 
0208 
0209 
0210 
0211 
0212 
0213 
0214 
0215 
0216 
0217 
0218 
0219 
0220 
0221 
0222 
0223 
0224 
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TRA 


*+2 




0225 




TRA 


SETUP 




0226 




TRA 


LUKTSB 




0227 


* MERGE POINT. 


0,4 IS NOW * TSX $TIMSUB,4 




0228 


» SET 


MNCWI , MNCWO, MNACC, AND FMNACC 




0229 


SETUP 


CLA* 


1,4 MINACC FXD 




0230 




TZE 


3,4 




0231 




TMI 


3,4 




0232 




STO 


MNACC 




0233 




ARS 


3 




0234 




ADO 


MNACC 




0235 




STO 


MNCWI 




0236 




STO 


MNACC 




0237 




ZET 


ZIFINT 




0238 




ARS 


3 




02 39 




STO 


MNCWO 




0240 




LDQ 


KD1 




0241 




TLQ 


*+2 




0242 




STQ 


MNCWO 




0243 




CLA* 


It 4 




0244 




ARS 


18 




0245 




ORA 


OCTK 




0246 




FAD 


OCTK 




0247 




STO 


FMNACC 




0248 


» SCAN 


DOWN TO 


TSX $SUB,4 (IN 1,4) 




0249 


SUBSCN 


TSX 


TSX4SC*! 




0250 




TXI 


*+i,4,-l 




0251 




CLA 


0,4 TSX $SUB,4 




0252 


• WE HAVE TO IGNORE INTERNAL FORTRAN SUBROUTINES, FOR WHICH THE 


0253 


* TSX 


X,4 HAS 


X GRTHN THE LOCATION OF THAT 


INSTRUCTION, UE. -X LSTHN 


0254 


* PRESENT VALUE OF XR4. 




0255 




PAC 


0,1 -X TO XR1 




0256 




SXD 


*+l,4 




0257 




TXL 


SUBSCN,!,** ** = XR4 




0258 


* OK, i 


LEGITIMATE SUBROUTINE FOUND 




0259 




STO 


SAVTSX 




0260 




PXA 


0,4 




0261 




PAC 


0,1 A(TSX $SUB,4) 




0262 




SXA 


TSXSUBA 




0263 




CLA 


0,4 TSX AtTTR SUB) 


t4 


0264 




STA 


TTSUB 




0265 




CLA* 


TTSUB 




0266 




STO 


SAVTTR 




0267 




CLA 


TSXSXA 




0268 




STO 


0,4 




0269 


* SCAN 


DOWN TILL 1,4 * NON TSX X,0 




0270 


ARGSCN 


TSX 


TSXZCKn 




0271 




TXI 


PXAARG, 4, -I NO MORE 




0272 




TXI 


ARGSCN*4,-1 KEEP GOING 




0273 


PXAARG 


PXA 


0,4 0,4 IS NOW EQUIV A(TSX ARGN,0)+1 


0274 




PAC 


0,1 




0275 




SXA 


FINISH, 1 




0276 




SXD 


LOCB,l 




0277 




SXA 


TTRLOB, 1 




0278 


• 








0279 


* TIMII 


NG LOOP. 


STEPS ARE 




0280 


* 








0281 


* STEP 


1. SET 


BYPASS IN TTSUB AND GO FIND TMWOUT 


0282 


TIMLUP 


CLA 


TTRLOB 




0283 




STO* 


TTSUB 




0284 




CLA 


MNCWO 




0285 




TSX 


OPTMAB, 1 




0286 




CLA 


SECSL 




0287 




STO 


TMWOUT 




0288 


* STEP 


2. REPLACE THE TTR SUB AND GO FIND 


TMWITH 


0289 


TMLUP1 


CLA 


SAVTTR 




0290 




STO* 


TTSUB 




0291 




CLA 


MNCWI 




0292 




TSX 


OPTMAB, 1 




0293 




CLA 


SECSL 




0294 




STO 


TMWITH 




0295 


• STEP 


3. FIND 


TMSUB 




0296 




FSB 


TMWOUT FORM TMSUB, 




0297 




STO 


TMSUB 




0298 


* STEP 


4. IF 


TMSUB*60. GRTHN^ MNACC, LEAVE 




0299 
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XCA 






0300 


FMP 


F60 




0301 


CAS 


FMNACC 




0302 


NOP 






0303 


TRA 


LEAVE 




0304 


* STEP 5. IF 


MNCWG*TMSUB/TMWOUT GRTHN* MNACC, LEAVE 


0305 


CLA 


MNCWO 


FORM FLOATING MNCWO 


0306 


ARS 


18 




0307 


ORA 


OCTK 




0308 


FAD 


OCTK 




0309 


STO 


FMNCWO 


DONE. 


0310 


CLA 


TMSU8 




0311 


FDP 


TMWGUT 




0312 


FMP 


FMNCWO 




0313 


CAS 


FMNACC 




0314 


NOP 






0315 


TRA 


LEAVE 




0316 


* STEP 6. PREDICT NEW 


MNCWO AND MNCWI 


0317 


CAS 


Fl 




0318 


TRA 


FMCWO 




0319 


* TMSUB HAS 


LSTHN= 1 


SIGNIFICANT FIGURES 


0320 


* SET NEW MNCWO=MNCWI 


= MNACC*MNCWI 


0321 


NOP 






0322 


LDQ 


MNCWI 




0323 


MPY 


MNACC 




0324 


ALS 


17 




0325 


STO 


MNCWI 




0326 


STO 


MNCWO 




0327 


TRA 


TIMLUP 




0328 


* SET MNCWI 


= MNACC*TMWI TH/TMSUB 


0329 


* SET MNCWO 


= MAX (MNCWO, MNACC*TMWOUT/TMSUB) 


0330 


FMCWO CLA 


FMNACC 




0331 


FDP 


TMSUB 




0332 


FMP 


TMWITH 




0333 


UFA 


OCTK 




0334 


ALS 


15 




0335 


STO 


MNCWI 




0336 


ALS 


3 




0337 


ADD 


MNCWI 




0338 


ADD 


Kl 




0339 


STO 


MNCWI 




0340 


CLA 


FMNACC 




0341 


FDP 


TMSUB 




0342 


FMP 


TMWOUT 




0343 


UFA 


OCTK 




0344 


ALS 


15 




0345 


LDQ 


MNCWO 




0346 


ADD 


Kl 




0347 


STO 


MNCWO 




0348 


ALS 


3 




0349 


ADD 


MNCWO 




0350 


STO 


MNCWO 




0351 


TLQ 


TIMLUP 




0352 


STQ 


MNCWO 




0353 


TRA 


TMLUPl 




0354 


* EXIT SEQUENCE 




0355 


LEAVE LXD 


TIMSUB- 


-2,4 


0356 


CLA 


TMSUB 




0357 


STO* 


2,4 


RELATIVE TO TIMSUB 


0358 


CLA 


SAVTSX 




0359 


STO* 


TSXSUB 




0360 


CLA 


Kl 




0361 


STO 


ZIFINT 




0362 


AXTLV AXT 


**,l 


** = XR1 ENTERING SUB 


0363 


AXT 


**,2 


** = XR2 ENTERING SUB 


0364 


AXT 


**,4 


** = XR4 ENTERING SUB 


0365 


CLA 


SAVAC 


AC AFTER SUBROUTINE 


0366 


LDQ 


SAVMQ 


MQ AFTER SUBROUTINE 


0367 


TOV 


*♦! 




0368 


TRA* 


FINISH 




0369 


» INTERNAL SUBROUTINE 


TO OPERATE TIMA2B 


0370 


* LINKAGE XR1, RETURNS TO 1,1 


0371 


OPTMAB SXA 


OTABLV, 


1 


0372 


SXA 


OTABLV+1,2 


0373 


STO 


MNAC 




0374 
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TSX 


$TIMA2B,4 




0375 




TSX 


LOCA,0 




0376 




TSX 


LOCB,0 




0377 




TSX 


MNAC,0 




0378 




TSX 


SECSL, 0 




0379 




STO 


SAVAC 




0380 




STQ 


SAVMQ 




0381 


OTABLV 


AXT 


**a 


** - XR1 


0382 




AXT 


**,2 


** = XR2 


0383 




TRA 


1,1 




0384 


• THE FOLLOWING IS LOCA FOR 


TIMA2B 


0385 


BEGIN 


AXT 


»**1 


** = APPROPRIATE XR1 


0386 




AXT 


**,2 


*• s APPROPRIATE XR2 


0387 




TRA* 


START 




0388 


• (THE 


FOLLOWING IS A PATCH 


IN OPERATING LOOP LOCA TO LOCB) 


0389 


LUPSXA 


SXA 


AXTLV,1 




0390 




SXA 


AXTLV+1,2 




0391 




SXA 


AXTLV+2,4 




0392 




TRA* 


TTSUB 




0393 


» INTERNAL SUBROUTINE TO BUMP XR4 UNTIL 1,4 = TSX X,4 


0394 


* 


LINKAGE 


XR1, RETURN 


TO 1,1 


0395 


TSX4SC 


SXA 


T4SCLV,1 




0396 


CLATS4 


CLA 


TSXZ4 




0397 




TSX 


INSTCK,1 




0398 




TXI 


CLATS4*4,-1 


NO 


0399 


T4SCLV 


AXT 


**,1 




0400 




TRA 


1,1 




0401 


• INTERNAL SUBROUTINE TO CHECK IF 1,4 * TSX X,0 


0402 


• 


RETURNS 


TO 1,1 IF NOT 


, TO 2,1 IF SO 


0403 


TSXZCK 


CLA 


TSXZ 




0404 


» INTERNAL SUBROUTINE TO CHECK IF 1,4 , LESS AODRESS, EQUALS AC 


0405 


* 


RETURNS 


TO 1,1 IF NOT 


, TO 2,1 IF SO 


0406 


INSTCK 


STO 


TEMP 




0407 




CAL 


1,4 




0408 




ANA 


AMASK 




0409 




LAS 


TEMP 




0410 




TRA 


* + 2 




0411 




TRA 


2,1 


YES 


0412 




TRA 


1,1 


NO 


0413 


* CONSTANTS, TEMPORARIES 




0414 


AMASK 


OCT 


777777700000 




0415 


TSXZ 


TSX 


0,0 




0416 


TSXZ4 


TSX 


0,4 




0417 


TSXSXA 


TSX 


LUPSXA^4 




0418 


Kl 


PZE 


1 




0419 


KOI 


PZE 


,,1 




0420 


Fl 


DEC 


1. 




0421 


F60 


DEC 


60. 




0422 


TTRTIM 


TTR 


TIMSUB 




0423 


OCTK 


OCT 


233000000000 




0424 


TTRLOB 


TTR 


#♦ 


** ^= LOCB 


042 5 


START 


PZE 


*» 


** = TSXINT+1 OR TSXTIM+3 


0426 


DSTART 


PZE 


0,0,** 


** = DITTO 


0427 


FINISH 


PZE 


** 


** = A(TSX ARGN,0)+1 


0428 


TSXSUB 


PZE 


** 


** = A(TSX $SUBZ4) 


0429 


TTSUB 


PZE 


*• 


** = A( TTR SUB) 


0430 


SAVTSX 


TSX 


**,4 


** - $SUB 


0431 


SAVTTR 


TTR 


»* 


** * SUB 


0432 


TMWOUT 


PZE 


**,««,** 




0433 


TMWITH 


PZE 


»«,«*, *» 




0434 


TMSUB 


PZE 


**,**, ** 




0435 


FMNACC 


PZE 


** 9 ** f «* 


FLTG. MNACC 


0436 


MNACC 


PZE 


0,0,** 


FOR TIMA2B 


0437 


MNAC 


PZE 






0438 


FMNCWO 


PZE 






0439 


MNCWO 


PZE 






0440 


MNCWI 


PZE 






0441 


SECSL 


PZF 


**,##, *# 


FROM TIMA2B 


0442 


LOCB 


PZE 


0,0,** 


FOR TIMA2B (SAME AS FINISH) 


0443 


LOCA 


PZE 


0,0 , BEGIN 


FOR TIMA2B 


0444 


SAVAC 


PZE 


»*,*»,*# 


AC AFTER SUBROUTINE 


0445 


SAVMQ 


PZE 


**,«*,** 


MQ AFTER SUBROUTINE 


0446 


TEMP 


PZE 


*»,«*,«* 




0447 


ZIFINT 


PZE 


1 ZEROED 


BY INTSSB, RESET TO 1 ON EXIT 


0448 




END 






0449 
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» TINGL (SUBROUTINE) 9/8/64 LAST CARD IN DECK IS NO. 0146 

* FAP 0001 
♦TINGL 0002 

COUNT 150 0003 

LBL TINGL 0004 

ENTRY TINGL CYOFX, LY, DELX, TING) 0005 

ENTRY TINGLA (YOFX, LY, DELX, TINGA) 0006 

* 0007 

* 0008 

* - ABSTRACT 0009 

* 0010 

* TITLE - TINGL, WITH SECONDARY ENTRY TINGLA 0011 

* DEFINITE TRAPEZOIDAL INTEGRAL OF FUNCTION OR ITS MAGNITUDE 0012 

* 0013 
» TINGL COMPUTES TRAPEZOIDAL INTEGRALS OF FORM 0014 

* 0015 

* LY-1 0016 
» DELX * (Y(l)/2 + SUM Yf I ) ♦ Y<LY)/2) 0017 

* 1=2 0018 
» 0019 
» WHERE YU...LY), LY, AND DELX ARE INPUTS, AND 0020 

* WHERE THE SUMMATION IS SUPPRESSED FOR LY * 2 . 0021 
» 0022 

* TINGLA COMPUTES THE SAME EXPRESSION BUT USES ABSOLUTE 0023 

* VALUES OF Y RATHER THAN Y ITSELF. 0024 

* 0025 
» LANGUAGE - FAP SUBROUTINES < FORTRAN- 1 1 COMPATIBLE) 0026 

* EQUIPMENT - 709,7090,7094 t MA IN FRAME ONLY) 0027 
» STORAGE - 43 REGISTERS 0028 

* SPEED - TAKES ABOUT 70 ♦ 8.4*LY MACHINE CYCLES, ON THE 7090 0029 

* AUTHOR - S.M. SIMPSON, JUNE 1964 0030 

* 0031 
« 0032 

* USAGE 0033 

* 0034 

* TRANSFER VECTOR CONTAINS ROUTINES - NOT ANY 0035 
» AND FORTRAN SYSTEM ROUTINES - NOT ANY 0036 

* 0037 

* FORTRAN USAGE 0038 

* CALL TINGL IYOFX, LY, DELX, TING) 0039 

* CALL TINGLACYOFX, LY, DELX , TINGA) 0040 
» 0041 

* 0042 

* INPUTS 0043 

* 0044 

* YOFX(I) 1 = 1.. .LY IS THE FLOATING VECTOR YU) OF THE ABSTRACT. 0045 

* 0046 
» LY MUST EXCEED 1 . 0047 
« 0048 

* DELX IS THE INCREMENT. MAY BE POSITIVE OR NEGATIVE. 0049 
» 0050 

* 0051 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LY LSTHN 2 . 0052 
» 0053 

* TING IS THE OUTPUT OF TINGL, GIVEN BY THE EXPRESSION IN THE 0054 
» ABSTRACT. 0055 

* 0056 

* TINGA IS THE OUTPUT OF TINGLA AS DESCRIBED IN ABSTRACT. 0057 
» NOTE THAT THE SIGN OF TINGA IS THAT OF DELX* 0058 

* 0059 

* 0060 

* EXAMPLES 0061 

* 0062 

* 1. INPUTS - Y0FXI1...4) = -2. ,-1. , 1., 3. DELX = 2.0 0063 
» TINGI1«..4) = TINGAU...4) = -99. ,-99. ,-99. , -99. 0064 
» USAGE - DC 10 LY=1,4 0065 

* CALL TINGL {YOFX, LY, DELX, TING(LY)) 0066 

* 10 CALL TINGLACYOFX* LY, DELX, TINGA(LY)) 0067 
« OUTPUTS - TING (1...4) = -99. ,-3.0,-3.0, I. 0 0068 
» TINGAU...4) = -99., 3.0, 5.0, 9.0 0069 
« 0070 

* 0071 

* PROGRAM FOLLOWS BELOW 0072 

* 0073 
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* NO TRANSFER VECTOR 0074 

* 0075 
HTR 0 XRl 0076 
BCI 1, TINGL 0077 

* 0078 

* PRINCIPAL ENTRY. TINGL (YOFX, LY, DELX, TING) 0079 

* 0080 
TINGL STZ ZFTNGL 0081 

TRA SETUP 0082 

» 0083 

« SECONDARY ENTRY. TINGLA( YOFX* LY, DELX, TINGA) 0084 

* 0085 
TINGLA SXD ZFTNGL ,4 0086 

* 0087 

* CHECK LY AND SET ADDRESS OF YOFX 0088 

* 0089 
SETUP SXD TINGL-2,1 0090 

CLA* 2,4 LY 0091 

TMI LEAVE 0092 

PDX 0,L 0093 

TXL LEAVE, 1,1 MUST EXCEED 1 0094 

CLA 1,4 A(YOFX) 0095 

STA FAD 0096 

STA FAM 0097 

* 0098 

* SET VARIABLE INSTRUCTIONS ACCORDING TO ENTRY 0099 

* 0100 
CLA NOP ANTICIPATE FOR TINGL 0101 
LDQ FAD 0102 
NZT ZFTNGL 0103 
TRA NOPSET 0104 
CLA SSP NO, IT WAS TINGLA 0105 
LDQ FAM 0106 

NOPSET STO N0P1 0107 

STQ N0P2 0108 

STQ N0P3 0109 

* 0110 
» FIRST AND LAST TERMS OVER 2 0111 
» 0112 

TXI *+l,l,-i IXRl * LY-l) 0113 

CLA* 1,4 YOFX(l) 0114 

N0P1 NOP = NOP OR SSP 0115 

N0P2 NOP * FAD **,1 OR FAM **, I *# * A(YOFX) 0116 

XCA 0117 

FMP KP5 0118 

TXI *+l,l,-i (XRl = LY-2) 0119 

TXL XCA, 1,0 (BYPASS FOR LY = 2) 0120 

* 0121 

* CENTRAL TERMS LOOP. XRl = LY-2 , LY-3, . . . , 1 0122 

* 0123 
N0P3 NOP = FAD **,1 OR FAM **,1 *# * A(Y0FX1 0124 

TIX N0P3,1,1 0125 

* 0126 

* TIMES DELX AND STORED 0127 

* 0128 
XCA XCA 0129 

FMP* 3,4 DELX 0130 

STO* 4,4 TING 0131 

* 0132 

* EXIT 0133 

* 0134 
LEAVE LXD TINGL-2,1 0135 

TRA 5,4 0136 

* 0137 

* CONSTANTS, VARIABLES 0138 

* 0139 
KP5 DEC .5 0140 
NOP NOP 0141 
SSP SSP 0142 
FAD FAD **,1 ** = A(YOFX) 0143 
FAM FAM **,1 ** = A(YOFX) 0144 

ZFTNGL PZE 0,0,** ** = 0 IF TINGL, - XR4 IF TINGLA 0145 

END 0146 
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» TINGLA * * TINGLA » 
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REFER TO REFER TO 

TINGL TINGL 
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» TRMINO (SUBROUTINE) 9/4/64 LAST CARO IN DECK IS NO* 0076 

» LABEL 0001 

CTRMINO 0002 

SUBROUTINE TRMINCUTAPE, NBAKUP) 0003 

C 0004 

C 0005 

C ABSTRACT 0006 

C 0007 

C TITLE - TRMINO 0008 

C TERMINATE AN I NDATA-OUDAT A TAPE 0009 

C 0010 

C TRMINO USES SUBROUTINE OUOATA TO WRITE A ZERO-RECORD 001 1 

C NUMBER DUMMY RECORD ON A SPECIFIED UNIT AND THEN BACKS 0012 

C THE TAPE UP A SPECIFIED NUMBER OF FILES OR REWINDS IT. 0013 

C 0014 

C LANGUAGE - FORTRAN-II SUBROUTINE 0015 

C EQUIPMENT - 709,7090,7094 (MAIN FRAME PLUS ONE TAPE DRIVE) 1 0016 

C STORAGE - 67 REGISTERS 0017 

C SPEED - CONTROLLED BY SUBROUTINES OUDATA AND FSKIP 0018 

C AUTHOR - S.M. SIMPSON, JUNE 1964 0019 

C 0020 

C 0021 

C USAGE 0022 

C 0023 

C TRANSFER VECTOR CONTAINS ROUTINES - XLIMIT, OUDATA, FSKIP 0024 

C AND FORTRAN SYSTEM ROUTINES - (RWT) 0025 

C 0026 

C FORTRAN USAGE 0027 

C CALL TRMINO* ITAPE, NBAKUP) 0028 

C 0029 

C 0030 

C INPUTS 0031 

C 0032 

C ITAPE MUST EXCEED ZERO AND BE LSTHN= 20 0033 

C 0034 

C NBAKUP GRTHN= 0 REQUESTS TRMINO TO LEAVE TAPE POSITIONED 0035 

C NBAKUP FILES CLOSER TO TAPE START THAN ITS INPUT 0036 

C POSITION* NBAKUP=0 LEAVES TAPE READY TO READ 0037 

C THE DUMMY RECORD CREATED. 0038 

C LSTHN 0 REQUESTS TRMINO TO LEAVE TAPE REWOUND. 0039 

C 0040 

C 0041 

C OUTPUTS NO ACTION IF ITAPE ILLEGAL. OTHERWISE SEE ABSTRACT 0042 

C AND NBAKUP. 0043 

C 0044 

C 0045 

C EXAMPLES 0046 

C 0047 

C I. INPUTS - SUPPOSE A 5 RECORD SAMPLE INDATA-QUDATA TAPE HAS BEEN 0048 

C CREATED ON LOGICAL 9 BY THE FOLLOWING SEQUENCE. 0049 

C DO 10 1=1,10 0050 

C 10 XU) = FLOATFU) 0051 

C REWIND 9 0052 

C DO 20 1=1,5 0053 

C IRECNO = I 0054 

C 20 CALL 0UDATA(9, IRECNO, 10, X, I) 0055 

C 0056 

C USAGE - CALL TRMIN0(9, 2) 0057 

C DO 30 1=1,3 0058 

C IRECNOm * 0 0059 

C NCPTS = -I 0060 

C 30 CALL I NDATA ( 9 , IRECNO(I), NOPTS, DUMMY, ERR) 0061 

C 0062 

C OUTPUTS - IRECN0U...3) = 4,5,0 0063 

C 0064 

C 0065 

C PROGRAM FOLLOWS BELOW 0066 

C 0067 

IF (XLIMITF(ITAPE,1,20)) 9999,10,9999 0068 

10 IRECNO = 0 0069 

CALL OUDATA! ITAPE, IRECNO, 1, DUMMY, 1) 0070 

IF (NBAKUP) 30*20,20 0071 

20 CALL FSKIP( ITAPE, -N8AKUP-1) 0072 

GO TO 9999 0073 

30 REWIND ITAPE 0074 
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9999 RETURN 
END 



0075 
0076 
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REFER TO 

REREAD 



L I STINGS #»##♦##*##*#•#*»*«#»♦*#* 
* (TSH} # 
4* #•**»* •#«**#»#•«*«•**« 

REFER TO 

REREAD 



****#«**•**«»****«»*•»** 

» 4TSHM) * 
«**»*»*••*««***•*•*•*•** 

REFER TO 

REREAD 



##****•«**»*•*«•***»*«** 

• f TSHM) « 
«*»*««*•*#*•*#«•»••*»*** 

REFER TO 

REREAD 
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» UNPAKN (SUBROUTINE) 9/9/64 LAST CARO IN DECK IS NO* 0149 

» FAP 0001 

♦UNPAKN 0002 

COUNT 140 0003 

LBL UNPAKN 0004 

ENTRY UNPAKN < N, LD, 0, SCALE ) 0005 

* 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - UNPAKN 0009 

* UNPACK AND RESCALE A PACKED DATA VECTOR 0010 

* 0011 

* UNPAKN UNPACKS A VECTOR (SUCH AS IS PACKED 8Y PAKNJ AND 0012 

* FLOATS AND SCALES THE VALUES. 0013 

* 0014 

* LANGUAGE - FAP, SUBROUTINE (FORTRAN II COMPATIBLE) 0015 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0016 

* STORAGE - 78 REGISTERS 0017 
» SPEED - TIME IS LENGTH OF UNPACKED VECTOR TIMES 52 MACHINE CYCLES* 0018 

* AUTHOR - J.F. CLAERBOUT, JULY, 1962 0019 

* 0020 

* '-USAGE: 0021 

* 0022 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 0023 
« AND FORTRAN SYSTEM ROUTINES - NONE 0024 

* 0025 

* FORTRAN USAGE 0026 
« CALL UNPAKN ( N f LD »D* SCALE ) 0027 

* 0028 

* INPUTS 0029 

* 0030 
» N IS THE NUMBER OF POINTS IN A PACKED REGISTER. 0031 
» MUST BE GRTHN^l LSTHN=18 0032 

* IF =1 THE DATA IS UNCHANGED. 0033 

* IS FORTRAN II INTEGER 0034 

* 0035 

* D(I) I=t...(LD+N~l>/N) IS THE PACKED DATA. 0036 

* 0037 

* LD IS THE NUMBER OF UNPACKED DATA POINTS. 0038 

* IS FORTRAN II INTEGER. 0039 

* 0040 
» SCALE IS A FLOATING POINT SCALING BY WHICH THE UNPACKED 0041 
» DATA IS DIVIDED. 0042 

* 0043 

* OUTPUTS 0044 
« 0045 

* DU) 1 = 1.. .LD IS THE FLOATING POINT UNPACKED DATA. 0046 

* 0047 
« EXAMPLES 0048 

* 0049 

* 1. INPUTS - D11...6) - I. ,4. ,8. ,-7. ,5. ,2. LD=6 N=l SCALE * 1. 0050 

* OUTPUTS - DU...6) = l.,4., 8. ,-7. ,5. ,2. 0051 

* 0052 

* 2. INPUTS - DU...3) = OCT 200000040000, 737777377777, 100000237777 0053 
» LD*6 N=2 SCALE=16383.875 0054 

* OUTPUTS - D(1...6) = 1. ,4. ,8. ,-7. ,5. ,2. 0055 

* 0056 

* 3. INPUTS - 0(1. ..2) = OCT 237567720020, 0C0000000040 0057 

* LD = 6 N = 5 SCALE * 7.875 0058 

* OUTPUTS - DQ...6) = 1.02, 4.06, 8.00,-6.98, 4.95, 2.03 0059 
» 0060 
» 4. INPUTS - 0(1) ^= OCT 002117275004 LD=6 N = 7 SCALED. 875 0061 

* OUTPUTS - DU...6) * 1.07, 4.27, 8.00,-6.93, 4.80, 2.13 0062 
» 0063 

* 5. INPUTS - 0(1) « OCT 000000000724 LD=6 N=L8 SCALE=0.125 0064 

* OUTPUTS - DU...6) = 0., 8., 8. ,-8., 8., 0. 0065 

* 0066 

* 0067 
» PROGRAM FOLLOWS BELOW 0068 

* 0069 
HTR 0 0070 
BCI I, UNPAKN 0071 

UNPAKN SXA SV1,1 0072 

SXA SV2,2 0073 

SXO UNPAKN-2,4 0074 
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CLA» 


1.4 




0075 




ARS 


18 




0076 




STO 


N 




0077 




SUB 


= 1 




0078 




TZE 


5,4 




0079 




CLA* 


2,4 




0080 




ARS 


18 




0081 




STO 


L 




0082 




CLA 


3,4 




0083 




ADD 


= 1 




0084 




STA 


DIO 




0085 




STA 


Dll 




0086 




STA 


D12 




0087 




STA 


D13 




0088 




SET UP 


TO JUMP 


IN LOOP IN PROPER SPOT 


0089 




FOR EASIEST PROOFREADING, READ UNPACKING LOOP FIRST. 


0090 




LXA 


L,2 


C(L)=NO. DATA PTS.,XR2 IS SET FOR LOOP 


0091 




CLA 


=0 




0092 




LDQ 


=36 




0093 




DVP 


N 




0094 




STQ 


NB 


C(NB)=BITS PER PACKED WORD 


0095 




XCA 






0096 




SUB 


= 1 


NUMBER OF BITS PER PACKED WORD EXCLUDING SIGNBIT 


0097 




STA 


LLS 




0098 




CLA 


L 


COMPUTE NUMBER OF PACKED REGISTERS 


0099 




ADD 


N 




0100 




SUB 


= 1 




0101 




XCA 






0102 




CLA 


=0 




0103 




DVP 


N 




0104 




STQ 


M 


C(M)=NUMBER OF PACKED REGISTERS 


0105 




LXA 


M,4 


SETS XR4 PROPERLY FOR LOOP 


0106 




CLA 


= 0 WHAT IS REMAINDER 


0107 




LDQ 


L 




0108 




DVH 


N 




0109 




TZE 


NEXT 


IF ZERO, LOCP CAN BE ENTERED NOW AT THE BEGINNING. 


0110 




PAX 


,1 


SET REMAINDER TO XR1 = WORDS IN LAST REG. 


Olll 




SSM 






0112 




ADD 


N 




0113 




XCA 




(N-WORDS LEFT IN LAST PACKED REGISTER) 


0114 




CLA 


=0 




0115 




MPY 


NB 


(N-WORDS LEFT IN REGISTER )*( B I TS PER WORD) 


0116 




XCA 






0117 




STA 


RQL 




0118 




XEC 


DIO 


DO LDQ INSTR. 


0119 


RQL 


RQL 


*• 


SHIFT OUT MEANINGLESS INFO. 


0120 




TRA 


RESET 




0121 




BEGIN 


UNPACKING LOOP 


0122 


NEXT 


LXA 


N,l 


N=NUMBER PACKED PER REGISTER 


0123 


DIO 


LDQ 


»*,4 


**=DAT A+ 1, GET NEW PACKED REGISTER 


0124 


RESET 


CLA 


=0 




0125 


LLS 


LLS 


*• 


♦*=N0. BITS PER WORD LESS SIGNBIT 


0126 




RQL 


1 


GET RID OF OLD SIGN BIT 


0127 


Oil 


STO 


*»,2 


♦*=DATA+1, XR2 HAS UNPACKED WORD INDEX 


0128 




TXI 


»+l,2,- 


1 INDEX WORO STORAGE COUNT 


0129 




TIX 


RESET , 1 


,1 CONTINUE UNPACKING THIS WORD 


0130 




TlX 


NEXT, 4 41 GET NEXT PACKED WORD 


0131 




END UNPACKING 


LOOP 


0132 




FLOAT 


AND SCALE 




0133 


SV4 


LXD 


UNPAKN— 


2,4 


0134 




LXA 


L,l 


C(L)=TOTAL NUMBER OF UNPACKED WORDS 


0135 


D12 


CLA 


**,! 


»* = DATA+1 


0136 




ORA 


=0233000000000 


0137 




FAD 


=0233000000000 


0138 




FDP* 


4,4 




0139 


013 


STQ 


** , I 


♦* * DATA+1 


0140 




TIX 


012,1,1 




0141 


SVl 


AXT 


**,1 




0142 


SV2 


AXT 


♦ ♦,2 




0143 




TRA 


5,4 




0144 


N 


PZE 




NUMBER OF NUMBERS PACKED IN ONE REGISTER 


0145 


L 


PZE 




TOTAL NUMBER OF UNPACKED REGISTERS 


0146 


M 


PZE 




TOTAL NUMBER OF PACKED REGISTERS 


0147 


NB 


PZE 
END 




NUMBER OF BITS PER PACKED WORD 


0148 
0149 
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9/29/64 



LAST CARD IN DECK IS NO. 



»VARARG 



VARARG (SUBROUTINE) 
FAP 

COUNT 130 

LBL VARARG 

ENTRY VARARG (LOCS) 

* 

» ABSTRACT 

• 

» TITLE - VARARG 

* ENABLE FORTRAN VARIABLE LENGTH CALLING SEQUENCES 
• 

* VARARG IS USED IN CONJUNCTION WITH FORTRAN II SUBROUTINES 
» TO ENABLE THEM TO HAVE VARIABLE LENGTH CALLING SEQUENCES. 
• 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 

* STORAGE - 44 REGISTERS 

* SPEED 

* AUTHOR - J.F. CLAERBOUT 
* 

* USAGE 

• 

* TRANSFER VECTOR CONTAINS ROUTINES - NONE 

* AND FORTRAN SYSTEM ROUTINES - NONE 
• 

» FORTRAN USAGE 

* CALL VARARG ( LOCS ) 

* THIS MUST BE THE FIRST STATEMENT IN THE FORTRAN 

* SUBROUTINE AND SHOULD BE FOLLOWED AS CLOSELY AS 

* POSSIBLE BY THE RETURN STATEMENT. 
* 

* OUTPUTS 



Locsm 



EXAMPLES 
USAGE 



1=1.* .N+l N^NUMBER OF ARGUMENTS IN CALLING STATEMENT 
CONTAIN THE ADDRESSES OF THE CONTENTS OF THE ARGUMENTS. 
I.E. 

LOCS(l) « XLOCF(ARGl) 
L0CS(2) = XL0CFURG2) 



LOCS(N) = XLOCF(ARGN) 
LCCS(N+l) = 0 

ARE FORTRAN II INTEGERS. 

THE CODING FOR THE RETURN TO THE CALLING PROGRAM IS 
ALTERED SO THAT THE SUBROUTINE RETURNS TO THI PROPER 
POSITION. THIS ALTERATION OCCURS ONLY FOR THE RETURN 
STATEMENT IMMEDIATELY FOLLOWING THE CALL VARARG 
STATEMENT • 



ASSUME A SUBROUTINE WITH THE FOLLOWING FORM 
SUBROUTINE XXXXXX ( ARG1 , . . . , ARGK ) 
DIMENSION L0CS(N+1) 
CALL VARARG (LOCS) 
GO TO 20 



10 
20 



RETURN 
CONTINUE 



THE REST OF THE SUBROUTINE IS INSERTED Hf RE 



GO TO 
END 



10 



* 1. INPUTS - 



XLOCF(ARGl) = 32561 
XL0CFURG2) * 32560 



USAGE 



XLOCF(ARGIO) = 32552 

CALL XXXXXX (ARGl f ARG2,< 



• • t ARG10 ) 



0131 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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* OUTPUTS - 


INSIDE THE SUBROUTINE XXXXXX LOCSC 1 )=32561# 


0075 








* 


0076 








• 


0077 








LOCS( 10)=325§2 


0078 








NORMAL RETURN 


0079 
0080 




HTR 




0 


0081 




BCI 




1, VARARG 


0082 


VARARG 


SXD 




•-2,4 


0083 




SXA 




SVl,l 


0084 




CLA 




1,4 


0085 




ADD 




= 1 


0086 




STA 




LOCS1 


0087 




AXT 




1,1 XR1 WILL REFER TO THE VECTOR LOCS 


0088 


• 


NEED 


TO 


FIND PROG. WHICH CALLED XXXXXX 


0089 


• 


LOOK 


FOR SXD INSTRUCTION IN XXXXXX 


0090 


A 


CAL 




-1*4 


0091 




ANA 




=0777777700000 CHECKS XR4 ALSO 


0092 




LAS 




SXD4 


0093 




TXI 




A,4,i 


0094 




TRA 




» + 2 


0095 




TXI 




A, 4,1 


0096 


» 


HAVE 


GOT SXD, NOW RESET XR4 TO LOOK AT XXXXXX S CALLING PROG 


0097 




CLA 






0098 




STA 




•♦1 


0099 




LXD 




• ♦,4 


0100 


• 


NOW 




LOOK FOR TAGLESS TSX INSTRUCTIONS 


0101 


B 


CAL 




1,4 


0102 




ANA 




=0777777700000 


0103 




SUB 




TSX 


0104 




TNZ 




C 


0105 


• 


SET 


ADDRESSES IN LOCS VECTOR 


0106 




CLA 




1,4 


0107 




ALS 




18 


0108 


LOCS1 


STO 




♦ » , I 


0109 




TXI 




*+l,l,l 


0110 




TXI 




B,4,-l CONTINUE SCAN 


0111 


• 


END 


OF 


CALLING SEQUENCE, LOCS ALMOST ALL SET UP 


0112 


c 


TOV 




•+1 


0113 




STZ* 




L0CS1 LOCS ALL SET UP 


0114 


» 


SET 


UP 


RETURN STATEMENT IN XXXXXX 


0115 




LXD 




VARARG-2,4 LOOK FOR 


0116 


D 


CAL 




0,4 TRA X,4 


0117 




ANA 




=0777777700000 


0118 




SUB 




TRA4 


0119 




TZE 




**2 


0120 




TXI 




D,4,-l 


0121 




PXA 




,1 


0122 




STA 




0,4 


0123 


» 


RETURN 


TO XXXXXX 


0124 


SV4 


LXD 




VARARG-2,4 


0125 


SVl 


AXT 




**, 1 


0126 




TRA 




2,4 


0127 


SXD4 


SXD 




0,4 


0128 


TSX 


TSX 






0129 


TRA4 


TRA 
END 




0,4 


0130 
0131 
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» VDOTV ( SUBROUTINE ) 9/4/64 LAST CARD IN DECK IS NO, 0120 

* FAP 0001 
•VDOTV 0002 

COUNT 150 0003 

LBL VDOTV 0004 

ENTRY VDOTV IX, Y, LXY, DVSR, XDYODV) 0005 

* 0006 

* 0007 

* ABSTRACT 0008 

* 0009 

* TITLE - VDOTV 0010 
» DOT PRODUCT OF TWO VECTORS WITH DIVISION BY CONSTANT 0011 
» 0012 

* VDOTV COMPUTES 0013 

* 0014 

* 1 LXY 0015 

* XDYODV = - SUM XU)*Y(I) 0016 

* DVSR 1=1 0017 

* 0018 
» WHERE LXY, DVSR,- XU...LXY) AND YU...LXY) ARE 0019 

* INPUTS, EXCEPT THAT IF THE MAGNITUDE OF DVSR IS ZERO, 0020 
» IT IS SET EQUAL TO THE SUM, AND XDYODV IS SET * 1,0 . 0021 

* 0022 
« LANGUAGE - FAP SUBROUTINE ( FORTRAN- I I COMPATIBLE) 0023 

* EQUIPMENT - 709,7090,7094 (MAIN FRAME ONLY) 0024 

* STORAGE - 25 REGISTERS 0025 
» SPEED - TAKES 47 + 23.4«LXY MACHINE CYCLES ON THE 7090 0026 

* AUTHOR - S.M. SIMPSON, JULY 1964 0027 
» 0028 
» 0029 

* ^ USAGE 0030 

* 0031 
» TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0032 

* AND FORTRAN SYSTEM ROUTINES - I NOT ANY) 0033 
» 0034 

* FORTRAN USAGE 0035 

* CALL VDQTVU, Y# LXY, DVSR, XDYODV) 0036 
» 0037 
» 0038 
» INPUTS 0039 

* 0040 

* X(I) 1=1. • .LXY IS FLOATING POINT. 0041 

* 0042 

* Yd) 1 = 1. ..LXY IS FLOATING POINT. EQUIVALENCE IX, Yl IS 0043 

* PERMITTED AS IS ANY OTHER TYPE OF OVERLAP. 0044 

* 0045 

* LXY MUST EXCEED ZERO. 0046 
» 0047 
» DVSR IS FLOATING POINT, OR ZERO. 0048 
» 0049 
» 0050 
« OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LXY IS ILLEGAL* 0051 

* 0052 

* DVSR EQUALS ITS INPUT VALUE UNLESS THAT WERE ZERO IN WHICH 0053 

* CASE IT EQUALS SUM (FROM 1=1 TO LXY) OF XCJ)*Y(I). 0054 
» 0055 
» XDYODV HAS VALUE GIVEN BY THE EXPRESSION IN THE ABSTRACT, EXCEPT 0056 
» THAT IT HAS VALUE 1.0 IF THE INPUT VALUE OF DVSR 0057 

* WERE ZERO. 0058 

* 0059 

* 0060 
» EXAMPLES 0061 

* 0062 
» 1. INPUTS - X(l...3) = l.,2.,3. Yd. ..3) = -l.,2.,-3. 0063 

* XDYU...5) = -99. ,-99. ,...,-99. DVSR = 2.0 0064 

* USAGE - DO 10 1=1,5 0065 

* LXY = 1-2 0066 

* 10 CALL VDOTV(X, Y, LXY, DVSR, XDY(I)) 0067 

* OUTPUTS - XDYU...5) = -99. ,-99. ,-.5, 1.5,-3.0 0068 

* 0069 

* 2. INPUTS - XU...4) = l.,2.,3.,4. SQRSUM = 0.0 0070 

* USAGE - DO 10 1=1,4 0071 

* 10 CALL VDOTVIX, XU), 5-1, SQRSUM, ACOR(I)? 0072 
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♦ OUTPUTS 


- SQRSUM = 30 


.0 AC0R(1...4) » 1.0, 0.66667, 0;36667*0. 13333 


0073 


• 






0074 


• 






0075 


• PROGRAM FOLLOWS BELOW 




0076 


• 






0077 


» NO TRANSFER 


VECTOR 




0078 


* 






0079 


BCI 


1 , VDOTV 




0080 


• 






0081 


» ONLY ENTRY. 


VDOTVU, Y, 


LXY, DVSR, XDYODV) 


0082 


• 






0083 


VDOTV SXA 


LEAVE, 1 




0084 


Kl CLA 


It* 


A(X) 


0085 


ADD 


Kl 


A(X)+1 


0086 


STA 


LDQ 




0087 


CLA 


2,4 


A( Y) 


0088 


ADD 


Kl 


A ( Y ) +1 


0089 


STA 


FMP 




0090 


* 






0091 


» CHECK OUT LENGTH 




0092 


» 






0093 


CLA» 


3,4 


LXY 


0094 


TMI 


LEAVE 




0095 


PDX 


0,1 




0096 


TXL 


LEAVE, 1,0 




0097 


STZ 


TEMP 




0098 


• 






0099 


» LOOP 






OiOO 


• 






0101 


LDQ LDQ 


♦ •♦1 


»* - A{X)*1 


0102 


FMP FMP 


*»,1 


♦* a A ( Y )+l 


0103 


FAD 


TEMP 




0104 


STO 


TEMP 




0105 


TIX 


LDQ,l,l 




0106 


• 






0107 


• NORMALIZE, 


IF DVSR NON 


-ZERO, AND STORE 


0108 


• 






0109 


NZT* 


4,4 


DVSR 


0110 


STO* 


4,4 




0111 


FDP* 


4,4 




0112 


STQ* 


5,4 


XDYODV 


0113 


LEAVE AXT 


•♦♦1 


•* = XR1 INITIAL 


0114 


TRA 


6,4 




0115 


• 






0116 


» TEMPORARY 






0117 


• 






0118 


TEMP PZE 






0119 


END 






0120 
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#*4t •**»*» ••••***•*»••••* 
« VDVBYV * 
#••#***•####«*****•**•** 



* VDVBYV (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0089 

* FAP 0001 
•VDVBYV 0002 

COUNT 100 0003 

LBL VDVBYV 0004 

ENTRY VDVBYV (X,Y,LXY,XDVBYY ) 0005 

* 0006 

* ~ ABSTRACT 0007 

* 0008 

* TITLE - VDVBYV 0009 

* DIVIDE ELEMENTS OF ONE VECTOR BY THOSE OF ANOTHER 0010 
» 0011 

* VDVBYV DIVIDES EACH ELEMENT OF A FLOATING VECTOR BY THOSE 0012 

* OF ANOTHER, MAKING NO TEST FOR ZERO DIVISORS. OUTPUT 0013 

* MAY REPLACE EITHER INPUT VECTOR. 0014 

* 0015 
» LANGUAGE - FAP SUBROUTINE ( FORTRAN— I I COMPATIBLE) 0016 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0017 
» STORAGE - 22 REGISTERS 0018 

* SPEED - 7090 709 0019 
» 33 + (19 OR 24)*LXY MACHINE CYCLES* LXY * VECTOR LENGTH 0020 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 0021 

* 0022 

* USAGE 0023 

* 0024 

* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0025 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0026 

* 0027 

* FORTRAN USAGE 0028 

* CALL VDVBYV (X,Y^LXY, XDVBYY ) 0029 

* 0030 

* INPUTS 0031 

* 0032 
« X(I) 1=1.*. LXY IS A FLOATING VECTOR 0033 
« 0034 

* Yd) 1*1. ..LXY IS A FLOATING VECTOR, NONE OF WHOSE ELEMENTS 0035 
« = 0.0 0036 

* 0037 
« LXY SHOULD EXCEED 0 0038 
» 0039 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LXY LSTHN 1 0040 
» 0041 
» XDVBYY(I) 1 = 1.. .LXY IS XDVBYY(I) = XU)/Y(I) (USING FDP 0042 

* INSTRUCTION) 0043 

* 0044 

* EQUIVAIENCE(XDVBYY,X OR Y) IS PERMITTED* 0045 

* 0046 

* DIVISION BY ZERO TURNS ON THE DIVIDE CHECK INDICATOR BUT 0047 

* VDVBYV DOESN'T TEST THIS OR STOP THE PROGRAM. 0048 

* 0049 

* EXAMPLES 0050 

* 0051 

* 1. INPUTS - XU...3) = 2. ,4. ,6. Yd. ..3) = l.,2.,3. Z=0.G 0052 
» USAGE - CALL VDVBYV (X,Y,3,W) 0053 
» CALL VDVBYV (X,Y,1,U) 0054 
» CALL VDVBYV (X,Y,3,X) 0055 
» CALL VDVBYV (X,Y,0,Z) 0056 

* OUTPUTS - WU...3) = 2. ,2. ,2. U(l) = 2. 0057 

* XU...3) = 2. ,2. ,2. Z=0.0 (NO OUTPUT CASE) 0058 

* 0059 
» PROGRAM FOLLOWS BELOW 0060 

* 0061 
» 0062 
» NO TRANSFER VECTOR 0063 

HTR 0 XR4 0064 

BCI 1, VDVBYV 0065 

* ONLY ENTRY. VDVBYVtX,Y,LXY,XDVBYY) 0066 
VDVBYV SXD VDVBYV-2,4 0067 

Kl CLA 1,4 0068 

ADD Kl A(X)+1 0069 

STA GET 0070 

CLA 2,4 0071 

ADD Kl A(Y)+l 0072 

STA OIV 0073 

CLA 4,4 0074 
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ADD 


Kl 


A(XDV8YY)+1 


0075 


STA 


STORE 




0076 


CLA* 


3,4 


LXY 


0077 


TMI 


LEAVE 




0078 


PDX 


0,4 




0079 


TXL 


LEAVE, 4,0 




0080 


DIVISION 


LOOP 




0081 


GET CLA 


«*,4 


***A(X)+1 


0082 


DIV FDP 


*#,4 


***At Y)+l 


0083 


STORE STQ 


**,4 


**=A{XDVBYY)+1 


0084 


TIX 


GET, 4,1 




0085 


EXIT 






0086 


LEAVE LXD 


VDVBYV-2,4 




0087 


TRA 


5,4 




0088 


END 






0089 



•*•**«•»*****•»**••**•** PROGRAM LISTINGS **#**********#*** ft**!!*** 

* VECOUT * # VECOUT * 

•»•**«•••*• ••*••**•***** **»#*«•»******«•*•****** 



* VECOUT SUBROUTINE) 9/29/64 LAST CARD IS DECK IS NO. 0090 

» LABEL 0001 

CVECOUT 0002 

SUBROUTINE VECOUT! ITAPE,FMT»X, ILOt IHI 3 0003 

C 0004 

C ABSTRACT 0005 

C 0006 

C TITLE - VECOUT 0007 

C OFFLINE VECTOR OUTPUT WITH NORMAL OR LITERAL FORMAT 0008 

C 0009 

C VECOUT OUTPUTS A VECTOR RANGE ON A GIVEN TAPE UNIT 0010 

C ACCOROING TO A GIVEN FORMAT VECTOR. THE FORMAT VECTOR IS 0011 

C EITHER OF THE ORDINARY FORM OR MAY APPEAR AS LITERAL 0012 

C HOLLERITH, STRIPPED OF THE INITIAL AND TERMINAL 0013 

C PARENTHESES , IN THE CALLING SEQUENCE. 0014 

C 0015 

C LANGUAGE - FORTRAN— 1 1 SUBROUTINE 0016 

C EQUIPMENT - 709 OR 7090 < MAIN FRAME PLUS I TAPE UNIT} 0017 

C STORAGE - 66 REGISTERS 0018 

C SPEED - 0019 

C AUTHOR - S.M. SIMPSON, SEPTEMBER 1963 0020 

C 0021 

C — — USAGE 0022 

C 0023 

C TRANSFER VECTOR CONTAINS ROUTINES - FNOFMT, RPLFMT 0024 

C AND FORTRAN SYSTEM ROUTINES - <STH), (FID 0025 

C 0026 

C FORTRAN USAGE 0027 

C CALL VEC0UT<ITAPE,FMT,X,IL0,IHI) 0028 

C 0029 

C INPUTS 0030 

C 0031 

C ITAPE IS LOGICAL TAPE NUMBER. (NOT CHECKED FOR LEGALITY) 0032 

C 0033 

C FMT{ I ) 1=1,2,... IS AN ORDINARY FORMAT {FIRST CHARACTER IS () 0034 

C OR 0035 

C 1=1,0,-1,... IS A FORMAT STRIPPED OF ITS ENCLOSING 0036 

C PARENTHESES AND TERMINATED BY AN ALL-ONES 0037 

C FENCE. ITS FIRST CHARACTER MAY NOT BE A I, 0038 

C AND ITS SECOND CHARACTER MUST NOT BE A ) . 0039 

C IF THIS IS NEEDED, INSERT LEADING SPACES. 0040 

C 0041 

C XII) I=ILO.«.IHI IS THE VECTOR TO BE PRINTED 0042 

C 0043 

C ILO SHOULD EXCEED 0 {NOT CHECKED) 0044 

C 0045 

C IHI SHOULD BE GRTHN= ILO (NOT CHECKED) 0046 

C 0047 

C OUTPUTS FUNCTION IS EQUIVALENT TO THE FORTRAN PROGRAM BELOW 0048 

C 0049 

C WRITE OUTPUT TAPE IT APE , 10 , < XI I ) , 1 = ILO, IHI 1 0050 

C 10 FORMAT ( FMT ) 0051 

C 0052 

C EXAMPLES 0053 

C 0054 

C 1. WITH LITERAL HOLLERITH (WITH REPETITION TO CHECK REVERSAL 0055 

C SCHEME USED) 0056 

C INPUTS - X(l. ..§)=!., 2. ,3. ,4. ,5. 0057 

C 0058 

C USAGE - CALL VECOUT ( 2, 21H12H X(2.*.5) = ,4F5. 1,X,I2*§! 0059 

C DC 10 1*1,3 0060 

C 10 CALL VEC0UT(2,15H8H X(l) = ,F5.1,X,1#1) 0061 

C 0062 

C OUTPUTS - (PRINTED OFF-LINE FROM LOGICAL 2) 0063 

C X(2...5) * 2.0 3,0 4.0 5.0 0064 

C X(l) « 1.0 0065 

C X(l) = 1.0 0066 

C X(l) = 1.0 0067 

C 0068 

C 2. WITH OROINARY FORMAT 0069 

C INPUTS - FMTU...3) = 17H(8H X{ 1) = ,F5.1) X( 1) = 1. 0070 

C 0071 

C USAGE - CALL VECOUT( 2,FMT,X, 1, 1 ) 0072 

C 0073 

C OUTPUTS - {PRINTED OFF-LINE FROM LOGICAL 2) 0074 
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C X(l) = 1.0 

C 

C 

C PROGRAM FOLLOWS BELOW 
C 

DIMENSION COM<2) 
COMMON COM 

CALL FNDFMT < FMT* IXCFMT ) 
CALL RPLFMT(COM,COM( IXCFMT) ) 
GO TO 20 

10 CALL RPLFMT(COM(IXCFMT),COM) 
GO TO 9999 

20 WRITE OUTPUT TAPE ITAPE ,CCM, <X ( I) , I=1L0, IHI ) 

GO TO 10 
9999 RETURN 

END 
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0075 
0076 
0077 
0078 
0079 
0080 
C081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
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VINDEX 



REFER TO 
INDEX 



•:******•*»•*»••*»**•***» 

* VINDEX » 
#•«•«**»*#»**•**»*»»••#» 

REFER TO 
INDEX 



•*••••••••*****•****#*#* 

* VMNUSV * 
****«»•***«»***»♦»***♦#* 

REFER TO 
VPLUSV 



#«**•#••**«»*#«**•*••**• 

# VMNUSV » 
«*«•*«*•*•*•*•**«•**•*** 

REFER TO 

VPtUSV 
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# VOUT * 
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• VOUT ( SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO* 0110 

* LABEL 0001 
CVOUT 0002 

SUBROUTINE VOUT U TAPE, NSPACE, X, XNAME, XFMT , ILO, IHI ) 0003 

C 0004 

C '-ABSTRACT 0005 

C 0006 

C TITLE - VOUT 0007 

C OUTPUT NAMED VECTOR BY NORMAL OR LITERAL FORMAT WITH SPACING 0008 

C 0009 

C VOUT WRITES OUT A VECTOR RANGE, XI ILO. . . IHI ) , ON A 0010 

C SPECIFIED TAPE UNIT ACCORDING TO A SPECIFIED FORMAT, 0011 

C WITH LABELING AND INITIAL SPACING (OR PAGE REST0RE1. 0012 

C THE FORMAT IS SPECIFIED EITHER AS A NORMAL FORMAT VECTOR 0013 

C OR AS LITERAL HOLLERITH IN THE CALLING SEQUENCE. 0014 

C 0015 

C LANGUAGE - FORTRAN-II SUBROUTINE 0016 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME PLUS ONE TAPE UNIT! 0017 

C STORAGE - 104 REGISTERS 0018 

C SPEED - 0019 

C AUTHOR - S.K. SIMPSON JR, OCTOBER 1963 0020 

C 0021 

C USAGE 0022 

C 002 3 

C TRANSFER VECTOR CONTAINS ROUTINES - CAR IGE, HRADJ, VECOUT 0024 

C AND FORTRAN SYSTEM ROUTINES - (STH), (FID 0025 

C 0026 

C FORTRAN USAGE 0027 

C CALL VOUT ( I TAPE INS P AC E, X, XNAME, XFMT ,ILO,IHI) 0028 

C 0029 

C INPUTS DEFINE A NORMLIT FORMAT VECTOR AS EITHER 0030 

C A) A NORMAL FORMAT VECTOR, 0031 

C OR 8) LITERAL HOLLERITH IN A CALLING SEQUENCE WHOSE 0032 

C CHARACTERS (READING CONTINUOUSLY FROM LEFT TO RIGHT1 0033 

C ARE THE DESIRED FORMAT STRIPPED OF THE ENCLOSING 0034 

C PARENTHESES. THE FIRST AND SECOND CHARACTERS MUS?T 0035 

C NOT BE QUOTE I UNQUOTE OR QUOTE ) UNQUOTE 0036 

C RESPECTIVELY. (TWO BLANKS FOLLOWED BY ( WOULD BE OK.'} 0037 

C 0038 

C I TAPE IS DESIRED LOGICAL TAPE NO. 0039 

C 0040 

C NSPACE IS DESIRED NO. OF SPACES (MAY BE ZERO) BEFORE ANY OUTPUT* 0041 

C IF NEGATIVE, AN INITIAL PAGE RESTORE OCCURS. 0042 

C 0043 

C X(I) I=IL0...IHI IS THE VECTOR RANGE TO BE PRINTED. MAY BE 0044 

C ANY MODE. 0045 

C 0046 

C XNAME IS THE NAME OF VECTOR X, IN F0RMAT(A6) OR *A5) 0R.*.U1). 0047 

C 0048 

C XFMT(I) IS A NORMLIT FORMAT VECTOR CONTROLLING THE OUTPUT 0049 

C OF X ( I ) • 0050 

C 0051 

C ILO SHOULD EXCEED ZERO (NOT CHECKED). 0052 

C 0053 

C IHI SHOULO BE GRTHN * ILO (NOT CHECKED). 0054 

C 0055 

C OUTPUTS 1. NSPACE SPACES OR A PAGE RESTORE OCCURS 0056 

C 2. A HEADING LINE OF THE GENERAL FORM 0057 

C XNAME ( ILO ,IL0+l , . . . , IHI } « 0058 

C APPEARS, IF IHI EXCEEDS ILO. IF IHI*IL0 THE HEADING 0059 

C I S 0060 

C XNAME ( ILO ) = 0061 

C 3. THE VALUES X( ILO. ..IHI) ARE THEN PRINTED ACCORDING TO 0062 

C XFMT. 0063 

C 0064 

C EXAMPLES 0065 

C 0066 

C I. WITH NORMAL FORMATS AND NAMES 0067 

C INPUTS - X(1...I4) * l.,2.,...,14. XNAME * 1HX, 0068 

C XFMTU...2) = 11H( 10X,5F8.1) Y = 7. YNAME * 1HY 0069 

C YFMT(1...2) = 10H(20X,F4.1) 0070 

C USAGE - CALL VOUT ( 2,3,X,XNAME,XFMT, 3, 14) 0071 

C CALL V0UT(2,3,Y,YNAME,YFMT,l,l) 0072 
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C OUTPUTS - THE FOLLOWING 12 LINES 0073 

C 0074 

C 0075 

C 0076 

C X < 3* 4 , . . . , 14 ) = 0077 

C 3.0 4,0 5.0 6.0 7.0 0078 

C 8.0 9.0 10.0 11.0 12.0 0079 

C 13.0 14.0 0080 

C 0081 

C 0082 

C 0083 

C Y t 1 ) = 0084 

C 7.0 0085 

C WILL BE PRINTED OFF LINE FROM LOGICAL TAPE 2 (UNDER 0086 

C PROGRAM CONTROL) 0087 

C 0088 

C 2. SAME DATA BUT WITH LITERAL ARGUMENTS 0089 

C INPUTS - XU...I4) AND Y SAME AS EXAMPLE 1 0090 

C USAGE - CALL VOUT < 2, 3, X* 1HX, 9H10X, 5F8. 1, 3, 14 ) 0091 

C CALL V0UT(2,3,Y,1HY,8H20X,F4.1,1,1) 0092 

C OUTPUTS - IDENTICAL TO THOSE OF EXAMPLE 1. 0093 

C 0094 

C PROGRAM FOLLOWS BELOW 0095 

C 0096 

CALL CARIGEI ITAPE,NSPACE) 0097 

XNMADJ-HRAD JF t XNAME ) 0098 

IF UHI-ILO) 9999,10,20 0099 

C SINGLE ELEMENT OUTPUT 0100 

10 WRITE OUTPUT TAPE I TAPE, 15,XNMADJ, I LO 0101 

15 FORMAT ( 1H ,A6,2H <,I5,5H ) =) 0102 

GO TO 30 0103 

C MULTIPLE ELEMENT OUTPUT 0104 

20 IL0P1=IL0+1 0105 

WRITE OUTPUT TAPE ITAPE,25,XNMADJ, ILO, IL0P1, IHI 0106 

25 FORMAT ( 1H ,A6,2W (,I5,2H ,,I5,10H , . . . ,,I5,5H ) =) 0107 

30 CALL VECOUT(ITAPE,XFMT,X,ILO,IHI) 0108 

9999 RETURN 0109 

END 0110 
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» VPLUSV ( SUBROUTINE) 9/29/64 LAST CARD I« DECK IS NO* 0126 

» FAP 0001 

•VPLUSV 0002 

COUNT 150 0003 

LBL VPLUSV 0004 

ENTRY VPLUSV ! X. Y,LXY.XPLUSY ) 0005 

ENTRY XVPLSV U X, I Y, LXY, IXPLSY) 0006 

ENTRY VMNUSV < X, Y,LXY,XMNUSY) 0007 

ENTRY XVMNSV i IX, I Y, LXY, IXMNSY) 0008 

• 0009 

• ABSTRACT 0010 

• 0011 

• TITLE - VPLUSV WITH SECONDARY ENTRIES XVPLSV, VMNUSV AND XVMNSV 0012 

• ADD OR SUBTRACT TWO FLOATING OR FIXED VECTORS 0013 
« 0014 

• VPLUSV ADDS TWO FLOATING VECTOR 0015 
» XVPLSV ADDS TWO FIXED VECTORS 0016 
» VMNUSV SUBTRACTS TWO FLOATING VECTORS 0017 
» XVMNSV SUBTRACTS TWO FIXED VECTORS 0018 

• 0019 
» OUTPUT MAY REPLACE EITHER INPUT VECTOR. 0020 

• 0021 
» LANGUAGE - FAP SUBROUTINES IFORTRAN-II COMPATIBLE) 0022 

• EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0023 

• STORAGE - 34 REGISTERS 0024 

• SPEED - VPLUSV 37 + 12.4*LXY MACHINE CYCLES, 0025 
» XVPLSV 39 ♦ 8.0*LXY LXY = VECTOR LENGTH 0026 

• VMNUSV 39 ♦ 12.4»LXY 0027 

• XVMNSV 39 + 8.0*LXY 0028 

• AUTHOR - S.M. SIMPSON, AUGUST 1963 0029 

• 0030 

• - USAGE-*— 0031 

• 0032 
» TRANSFER VECTOR CONTAINS ROUTINES - I NONE) 0033 

• AND FORTRAN SYSTEM ROUTINES - i NONE) 0034 

• 0035 

• FORTRAN USAGE 0036 
» CALL VPLUSVC; X, Y,LXY,XPLUSY) 0037 

• XVPLSVUX,IY, LXY, IXPLSY) 0038 

• VMNUSVt X, Y,LXY,XMNUSY) 0039 

• XVMNSVl'IX, I Y, LXY, IXMNSY) 0040 
» 0041 
» INPUTS 0042 

• 0043 

• XU) 1 = 1... LXY IS A FLOATING VECTOR 0044 

• 0045 

• YU) 1=1.*. LXY IS A FLOATING VECTOR 0046 

• 0047 

• LXY SHOULD EXCEED ZERO 0048 
» 0049 

• I X C I ) 1 = 1.. .LXY IS A FIXED VECTOR 0050 

• 0051 

• IYU) 1=1... LXY IS A FIXED VECTOR 0052 

• 0053 
» OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LXY LSTHN 1 0054 
» 0055 

• XPLUSYII) 1*1. * .LXY IS XPLUSYU) = XU) + YU) 0056 

• IXPLSYU) 1 = 1. ..LXY IS IXPLSYU) = IXU) ♦ IYU) 0057 
» XMNUSYII) 1 = 1.. .LXY IS XMNUSYU) = XU) - YU) 0058 
» IXMNSYII) 1 = 1.. .LXY IS IXMNSYU) = IXU) - IYU) 0059 

• 0060 

• EQUIVALENCE iXPLUSY OR XMNUSY, X OR Y),UXPLSY OR IXMNSY* 0061 
» IX OR IY) IS PERMITTED. 0062 

• 0063 
» EXAMPLES 0064 

• 0065 

• 1. INPUTS - XU...3) = 2. ,4. ,6. YU...3) = l.,2.,3. 0066 
» IXU. ..3) = 2,4,6 IYU. ..3) = 1,2,3 Z=0.0 0067 
» USAGE - CALL VPLUSV ( X, Y,3, XI) 0068 

• CALL XVPLSV UX,IY, 3,1X1) 0069 

• CALL VMNUSV < X, Y,3, X2) 0070 
» CALL XVMNSV < IX, I Y, 3 , 1X2 ) 0071 

• CALL VPLUSV I X, Y,3, X) 0072 
« CALL XVMNSV UX,IY,1,IY) 0073 
« CALL VPLUSV ( X, Y,0, Z) 0074 
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* OUTPUTS - XHU..3) » 3. ,6. ,9. 1X1(1.* 
» X2U...3) = l.,2.,3. 1X2(1. < 

* X U...3) * 3. ,6., 9. IY(l) = 

* Z * 0.0 (NO OUTPUT CASE) 
* 

* PROGRAM FOLLOWS 8EL0W 



.3) 
• 3) 
1 



3*6,9 
1*2,3 



0075 
0076 
0077 
0078 
0079 
0080 



• 






0081 


* 






0082 


* NO TRANSFER 


VECTOR 


0083 




HTR 


0 XR4 


0084 




BCI 


1, VPLUSV 


0085 


* PRINCIPAL ENTRY. VPLUSV ( X, Y*LXY, XPLUSY ) 


0086 


VPLUSV 


CLA 


FAD 


0087 


SETUP 


STO MODIFY 


0088 




SXD 


VPLUSV-2,4 


0089 


Kl 


CLA 


1*4 


0090 




ADD 


Kl A(X)+1 


0091 




STA 


GET 


0092 




CLA 


2,4 


0093 




ADD 


Kl A(Y)+1 


0094 




STA 


MODIFY 


0095 




CLA 


4,4 


0096 




ADD 


Kl A(XPLUSY)+1 


0097 




STA 


STORE 


0098 




CLA* 


3,4 LXY 


0099 




TMI 


LEAVE 


0100 




PDX 


0,4 


0101 




TXL 


LEAVE, 4,0 


0102 


» LOOP 






0103 


GET 


CLA 


*»,4 **=A(X)+1 


0104 


MODIFY 


NOP 


=FAD ««,4 ADD **,4 FSB **,4 SUB *»*4 


0105 


• 




»*=A(Y)-*1 


0106 


STORE 


STO 


• **4 »»=A(XPLUSY)+1 


0107 




TIX 


GET, 4,1 


0108 


* EXIT 






0109 


LEAVE 


LXD 


VPLUSV-2,4 


0110 




TRA 


5,4 


0111 


* SECOND ENTRY. XVPLSV ( IX , I Y,LXY, IXPLSY ) 


0112 


XVPLSV 


CLA 


ADD 


0113 




TRA 


SETUP 


0114 


» THIRD ENTRY. 


VMNUSV (X,Y, LXY, XMNUSY) 


0115 


VMNUSV 


CLA 


FSB 


0116 




TRA 


SETUP 


0117 


» FOURTH ENTRY, XVMNS VU X , I Y , LXY, IXMNSY ) 


0118 


XVMNSV 


CLA 


SUB 


0119 




TRA 


SETUP 


0120 


* CONSTANTS 




0121 


FAD 


FAD 


*»,4 


0122 


ADD 


ADD 


**,4 


0123 


FSB 


FSB 


**,4 


0124 


SUB 


SUB 


** ,4 


0125 




END 




0126 
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* VRSOUT * 



» VRSOUT (SUBROUTINE) 9/29/64 LAST CARO IN DECK IS NO* 0137 

» FAP 0001 

•VRSOUT 0002 

COUNT 150 0003 

LBL VRSOUT 0004 

ENTRY VRSOUT i ITAPE, NSPACE, FMT, SPACE, XI, X2, XN ) 0005 

» 0006 

» A8STRACT 0007 

» 0008 

* TITLE - VRSOUT 0009 

* OUTPUT VARIABLES BY NORMAL OR LITERAL FORMAT 0010 
» 0011 

* VRSOUT IS A VARIABLE-LENGTH-CALLING-SEQUENCE PROGRAM 0012 

* WHICH WRITES OUT, ON A SPECIFIED TAPE, A LIST @F VARf- 0013 

* ABLES ACCORDING TO A GIVEN FORMAT, WITH INITIAL SPACING 0014 

* OR PAGE RESTORE. THE FORMAT MAY BE EITHER A NORMAL 0015 
» FORMAT VECTOR, OR APPEAR AS LITERAL HOLLERITH IN THE 0016 

* CALLING SEQUENCE. 0017 

* 0018 
» LANGUAGE - FAP SUBROUTINE ( FORTRAN— I I COMPATIBLE) 0019 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME PLUS ONE TAPE UNIT) 0020 

* STORAGE - 47 REGISTERS 0021 

* SPEED - 0022 

* AUTHOR - S.M.SIMPSCN JR., OCTOBER 1963 0023 
» 0024 

* — — USAGE >- 0025 

» 0026 

* TRANSFER VECTOR CONTAINS ROUTINES - CAR IGE, VECOUT 0027 
» AND FORTRAN SYSTEM ROUTINES - (NONE) 0028 

* 0029 

* FORTRAN USAGE 0030 
» CALL VRSOUT ( I TAPE, NSPACE, FMT, SP ACE, X1,X2, . *.,XN) 0031 
» WHERE THE NO. OF VARIABLES, N, MUST EXCEED 0. 0032 

* 0033 

* INPUTS DEFINE A NORMLIT FORMAT VECTOR AS EITHER 0034 
» A) A NORMAL FORMAT VECTOR, 0035 

* OR B) LITERAL HOLLERITH IN A CALLING SEQUENCE WHOSE 0036 

* CHARACTERS (READING CONTINUOUSLY FROM LEFT TO RIGHT) 0037 

* ARE THE DESIRED FORMAT STRIPPED OF THE ENCLOSING 0038 

* PARENTHESES. THE FIRST AND SECOND CHARACTERS MUST 0039 

* NOT BE QUOTE ( UNQUOTE OR QUOTE ) UNQUOTE 0040 

* RESPECTIVELY. (TWO BLANKS FOLLOWED BY f WOULD BE OKi) 0041 

* 0042 
» I TAPE IS LOGICAL TAPE NO. OF DESIRED OUTPUT TAPE* 0043 

* 0044 
» NSPACE IS DESIRED NO. (MAY BE ZERO) OF SPACES BEFORE ANY OUTPUT. 0045 
» IF NEGATIVE AN INITIAL PAGE RESTORE OCCURS. 0046 

* 0047 

* FMT ( I ) IS A NORMLIT FORMAT VECTOR CONTROLLING THE OUTPUT OF 0048 

* XI.. .XN . 0049 

* 0050 
» SPACE(I) 1*1. 4. N MUST BE AVAILABLE AS SCRATCH* 0051 

* IF N=l, EQUIVALENCE (SPACE, XI) IS PERMITTED* 0052 
« 0053 

* X1,X2,...,XN ARE THE N VARIABLES (MODES ARBITRARY) TO BE PRINTED. 0054 

* 0055 

* OUTPUTS 1. NSPACE SPACES OR A PAGE RESTORE OCCURS. 0056 

* 2. X1,X2,...,XN ARE PRINTED ACCORDING TO FORMAT FMT. 0057 

* 0058 

* EXAMPLES 0059 

* 0060 

* 1. USING NORMAL FORMAT 0061 

* INPUTS - XI = 1., 1X2 = 2, 1X3 = 3 0062 

* FMTU...6) = 33H(5H XI =,F4.1,11H, 1X2,1X3 =,2141 0063 

* USAGE - DIMENSION SPACE(3) 0064 

* CALL VRSOUTt 2, 3, FMT, SPACE, XI, 1X2, 1X3) 0065 

* OUTPUTS - THE FOLLOWING 4 LINES 0066 

* 0067 
« 0068 

* 0069 

* XI = 1.0, 1X2,1X3 =24 0070 

* WILL PRINT OFF-LINE FROM LOGICAL TAPE 2 UNDER RROGRAM 0071 

* CONTROL 0072 

* 0073 

* 2. USING LITERAL FORMAT 0074 
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• INPUTS 


- XUIX2#IX3 


SAME AS FOR EXAMPLE 1. 


0075 


» USAGE 


CALL VRSOUT<2,3,31H5H XI «,F4.1,HH, 1X2,1X3 *|2I4, 


0076 


* 




1 


SPACE, XI, 1X2, 1X3) 


0077 


* OUTPUTS 


- IDENTICAL TO 


THOSE OF EXAMPLE 1. 


0078 


• 








0079 


» PROGRAM FOLLOWS B€LOW 




0080 


* 








0081 


♦ 








0082 


* TRANSFER VECTOR CONTAINS 


CARIGE, VECOUT 


0083 




HTR 


0 


XR1 


0084 




HTR 


0 


XR4 


0085 




BCI 


1, VRSOUT 




0086 


• ONLY 


ENTRY. 


VRSOUTt ITAPE 


,NS PACE, FMT, SPACE, X1,X2, . .. f XN) 


0087 


VRSOUT 


SXD 


VRSOUT-2,4 




0088 




SXD 


VRSOUT-3,1 




0089 




CLA 


lt4 


At I TAPE) 


0090 




STA 


CA1 




0091 




STA 


VA1 




0092 




CLA 


2,4 


AiNSPACE) 


0093 




STA 


CA2 




0094 




CLA 


3,4 


A(FMT) 


0095 




STA 


VA2 




0096 




CLA 


4,4 


A(SPACE) 


0097 




STA 


STO 




0098 




STA 


VA3 




0099 


» LOOP 


TO PACK UP THE VARIABLES INTO SPACE (1...N) 


0100 




AXT 


0,1 


XR1 COUNTS N 


0101 




TXI 


♦+1,4,-4 


(INITIALIZE TO 1,4^X1) 


0102 


CAL 


CAL 


lt4 


POSSIBLE TSX X,0 


C103 




ANA 


AMASK 




0104 




LAS 


TSXZ 




0105 




TRA 


♦+2 




0106 




TRA 


GETX 




C107 


« WHEN 


NO MORE, SET NO* VARIABLES AND GO OPERATE CARIGE. 


0108 




SXO 


N,l 




0109 




TRA 


OPCAR 




0110 


» STORE EACH 


X IN THE SPACE 


VECTOR, COUNT AND CYCLE 


0111 


GETX 


CLA* 


lt4 




0112 


STO 


STO 


♦♦♦1 


♦*=A( SPACE) 


0113 




TXI 


♦♦1,1,1 




0114 




TXI 


CAL, 4,-1 




0115 


* GO OPERATE 


CARIGE 




0116 


OPCAR 


SXA 


LEAVE, 4 




0117 




TSX 


$CARIGE,4 




0118 


CA1 


TSX 


♦♦,0 


♦**A( ITAPE) 


0119 


CA2 


TSX 


♦♦# 0 


♦**A(NSPACE) 


0120 


* AND 


THEN VECOUT 




0121 




TSX 


$VEC0UT,4 




0122 


VA1 


TSX 


♦ ♦#0 


♦*=A( ITAPE) 


0123 


VA2 


TSX 


♦♦,0 


♦*= A ( FMT ) 


0124 


VA3 


TSX 


♦♦,0 


**=A(SPACE) 


0125 




TSX 


KD1,0 


ILO^l 


0126 




TSX 


N,0 


IHI^N 


0127 


* ANO 


THEN EXIT 




0128 


LEAVE 


AXT 


♦♦♦4 


♦♦—XR4 TEMP 


0129 




LXD 


VRSOUT-3,1 




0130 




TRA 


1,4 




0131 


» CONSTANTS* 


TEMPORARIES 




0132 


KOI 


PZE 


0,0,1 




0133 


AMASK 


OCT 


777777700000 




0134 


TSXZ 


TSX 


0,0 




0135 


N 


PZE 


0»0»^ 


♦♦=N0. OF VARIABLES » N 


0136 




END 






0137 



»*•••**»»*•••******•«•«* 
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PROGRAM LISTINGS 



«**«*•*•«**••*#»•**••••• 

* VSOUT * 



» VSOUT < SUBROUTINE) 9/29/64 LAST CARD I HI DECK IS NO. 0124 

» FAP 0001 

•VSOUT 0002 

COUNT 150 0003 

L8L VSOUT 0004 

ENTRY VSOUT I ITAPE, NSPACE, XI, X 1NAME, X1FMT, IL01, IHIlt X2» 0005 

* X2NAME,X2FMT, IL02t IHI2, ,XN, XNNAME*XNFMT, 0006 

* ILON, IHIN) 0007 

* 0008 

* ABSTRACT 0009 

* 0010 

* TITLE - VSOUT 0011 

* OUTPUT NAMED VECTORS BY NORMAL OR LITERAL FORMATS WITH SPACING 0012 

* 0013 

* VSOUT IS A V AR I ABLE-LENGTH— CALL I NG-SEQUENCE PROGRAM WHICH 0014 

* WRITES OUT, ON A SPECIFIED TAPE UNIT, A LIST Of VECTOR 0015 

* RANGES » EACH RANGE ACCORDING TO A GIVEN FORMAT, WITH 0016 
» LABELING AND INITIAL SPACING OR PAGE RESTORING BEFORE 0017 

* EACH VECTOR. THE FORMATS ARE EITHER NORMA! FORMAT 0018 

* VECTORS OR MAY APPEAR AS LITERAL HOLLERITH IN THE CALLING 0019 

* SEQUENCE. ONE CALL OF VSOUT IS EQUIVALENT TO A 0020 
» SUCCESSION OF CALLS OF SUBROUTINE VOUT. 0021 

* 0022 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN— I I COMPATIBLE) 0023 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME PLUS ONE TAPE UNTII 0024 

* STORAGE - 37 REGISTERS 0025 

* SPEED - 0026 

* AUTHOR - S.M. SIMPSON JR., OCTOBER 1963 0027 
» 0028 

» USAGE— — 0029 

« 0030 

* TRANSFER VECTOR CONTAINS ROUTINES - VOUT 0031 
» AND FORTRAN SYSTEM ROUTINES - ( NONE ) 0032 

* 0033 

* FORTRAN USAGE 0034 
» CALL VSOUTt ITAPE, NSPACE, XI, X1NAME.X1FMT, IL01, IHIl, X2,X2NAME* 0035 

* 1 X2FMT,IL02,IHI2, XN,XNNAME, XNFMT, ILON, IHIN) 0036 
» 0037 
» WHERE THE NO. OF VECTORS, N, MUST EXCEED ZERO. 0038 
« 0039 

* THE ABOVE IS EQUIVALENT TO A SEQUENCE OF N CALLS OF VOUT. 0040 

* CALL V0UT(ITAPE**NSPACE,X1,X1NAME,X1FMT, IL01, IHI1) 0041 

* CALL V0UTUTAP6, NSPACE, X2, X2NAME, X2FMT, IL02,IHI2) 0042 
« ETC 0043 
« CALL VOUT(ITAPE^NSPACE,XN,XNNAME, XNFMT, ILON, IHIN) 0044 

* 0045 

* SEE WRITEUP OF SUBROUTINE VOUT FOR INPUT-OUTPUT DETAILS. 0046 

* 0047 

* EXAMPLES 0048 
» 0049 

* 1. WITH NORMAL FORMATS AND NAMES 0050 
« INPUTS - XU...14) * l.,2.,...,14. XNAME = 1HX, 0051 

* XFMTU...2) * 1 IH( 10X,5F8.1) Y = 7. YNAME * IHY 0052 
« YFMTU..*2) * 10H(20X,F4.1) 0053 
« USAGE - CALL VS0UT(2 ,3,0C, XNAME, XFMT,3, 14, Y, YNAME, YFMTi 1 ,11 0054 
« OUTPUTS - THE FOLLOWING 12 LINES 0055 
» 0056 
« 0057 
» 0058 

* X ( 3, 4 14 1 = 0059 
» 3.0 4.0 5.0 6.0 7.0 0060 
» 8.0 9.0 10*0 11.0 12.0 0061 

* 13.0 14.0 0062 
» 0063 
» 0064 

* 0065 

* Y ( 1 ) = 0066 

* 7.0 0067 
» WILL BE PRINTED OFF LINE FROM LOGICAL TAPE 2 (UNDER 0068 
» PROGRAM CGNTROL) 0069 
» 0070 
« 2. SAME DATA BUT WITH LITERAL ARGUMENTS 0071 

* INPUTS - XU...14) AND Y SAME AS EXAMPLE 1. 0072 
« USAGE - CALL VSOUT ( 2 , 3 ,X , 1HX , 9H10X, 5F8. 1 , 3, 14, Y.1HY, 0073 

* 8H20X,F4.1, I, I) 0074 



V 
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^ OUTPUTS - 


IDENTICAL TO 


THOSE OF EXAMPLE 1 




0075 
0076 


► PROGRAM FOLLOWS BELOW 






0077 


t 








0078 










0079 


► TRANSFER VECTOR CONTAINS 


VOUT 




0080 


HTR 


0 


XR4 




0081 


BCI 


1, VSOUT 






0082 


y ONLY ENTRY, 


VSOUT ( I TAPE , 


NSPACE,X1,XNAM1, XFMT1,IL01, IHIl,X2 f 


XNAM2, 


0083 




XFMT2 




IHIN) 


0084 


VSOUT SXD 


VSOUT-2,4 






0085 


CLA 


1,4 


At ITAPE) 




0086 


STA 


TSX1 






0087 


CLA 


2,4 


A(NSPACE) 




0088 


STA 


TSX2 






0089 


TXI 


•-1-1,4,-2 






0090 


► START LOOP 








0091 


CAL CAL 


i,4 


A(XK) K=l,2,.,. 




0092 


STA 


TSX3 






0093 


ANA 


AMASK 






0094 


LAS 


TSXZ 






0095 


TRA 


*+2 






C096 


TRA 


CLA 






0097 


► EXIT AT END 


OF GROUPS OF 


5 




C098 


TRA 


1,4 






0099 


► COMPLETE THE 


CALLING SEQUENCE 




0100 


CLA CLA 


2,4 


A { XNAMK) 




0101 


STA 


TSX4 






0102 


CLA 


3,4 


A ( XFMTK ) 




0103 


STA 


TSX5 






0104 


CLA 


4,4 


A( ILOK) 




0105 


STA 


TSX6 






0106 


CLA 


5,4 


At IHIK) 




0107 


STA 


TSX7 






0108 


* GO OPERATE VOUT 






0109 


SXA 


SVXR4,4 






0110 


TSX 


$V0UT,4 






0111 


TSX1 TSX 


**,0 


»*=A( ITAPE) 




0112 


TSX2 TSX 


** ,0 


»*=A(NSPACE) 




0113 


TSX3 TSX 


**»0 


***A(XK> K=l,2,„.. 




0114 


TSX4 TSX 


»*,0 


*»= A ( XNAMK ) 




0115 


TSX5 TSX 


**,0 


**=A(XFMTK) 




0116 


TSX6 TSX 


»*,0 


**=A< ILOK > 




0117 


TSX7 TSX 


**,0 


**=A( IHIK) 




0118 


SVXR4 AXT 


«*,4 






0119 


TXI 


CAL ,4,-5 






0120 


► CONSTANTS 








0121 


AMASK OCT 


777777700000 






0122 


TSXZ TSX 


0,0 






0123 


END 








0124 
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* VTIMSV » # VTIMSV * 

*•••*•*«**••****«*•***** «•»*#•*«•****##*****»*•* 

* VTIMSV (SUBROUTINE) 9/29/64 LAST CARD IW DECK IS NO. 0111 

* FAP 0001 
♦VTIMSV 0002 

COUNT 100 0003 

LBL VTIMSV 0004 

ENTRY VTIMSV ( X, Y, LXY, XT IMSY ) 0005 

ENTRY XVTMSV ( IX, I Y, LXY, IXTMSY) 0006 

* 0007 

* ■* ABSTRACT — — 0008 

* 0009 

* TITLE - VTIMSV WITH SECONDARY ENTRY XVTMSV 0010 
» MULTIPLY ELEMENTS OF TWO VECTORS FIXED OR FLOATING 0011 
» 0012 

* VTIMSV MULTIPLIES ELEMENTS OF TWO FLOATING VECTORS 0013 
« XVTMSV MULTIPLIES ELEMENTS OF TWO FIXED VECTORS 0014 

* 0015 

* OUTPUT MAY REPLACE EITHER INPUT VECTOR 0016 
» 0017 
» LANGUAGE - FAP SUBROUTINES i FORTRAN— 1 1 COMPATIBLE) 0018 

* EQUIPMENT - 709 OR 7090 ( MAIN FRAME ONLY) 0019 

* STORAGE - 34 REGISTERS 0020 

* SPEED - 7090 709 0021 

* VTIMSV 41 + (19.0 OR 22.2)*LXY MACHINE CYCLES* 0022 
» XVTMSV 43 + (20.6 OR 24.8)*LXY LXY * VECTOR LENGTH 0023 
» AUTHOR - S.M. SIMPSON, AUGUST 1963 0024 

* 0025 

» USAGE »- 0026 

» 0027 

» TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0028 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0029 

* 0030 

* FORTRAN USAGE 0031 

* CALL VTIMSV! X, Y, LXY, XTIMSY ) 0032 

* CALL XVTMSV(IX,IY, LXY, IXTMSY) 0033 

* 0034 

* INPUTS 0035 
» 0036 

* X(I) 1=1.. .LXY IS A FLOATING PT VECTOR 0037 
» Yd) 1*1. ..LXY IS A FLOATING PT VECTOR 0038 

* 0039 

* LXY SHOULD EXCEED ZERO 0040 
» 0041 
» IXU) 1 = 1. ..LXY IS A FIXED VECTOR, FORTRAN— 1 1 INTEGERS 0042 

* IYU) 1 = 1.. .LXY IS A FIXED VECTOR, FORTRAN— 1 1 INTEGERS 0043 

* 0044 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LXY LSTHN 1 0045 

* 0046 

* XTIMSY 1=1. ..LXY IS XTIMSY(I) = X(I) * Y(I) 0047 

* IXTMSY 1=1.. .LXY IS IXTMSY(I) = IXC I) * IY(I) 0048 

* 0049 

* DANGER OF FIXED POINT OVERFLOW IS NOT TESTED FOR BY 0050 

* XVTMSV. 0051 

* 0052 

* EQUIVALENCE (XTIMSY, X OR Y), (IXTMSY, IX OR IY) IS 0053 

* PERMITTED. 0054 

* 0055 

* EXAMPLES 0056 
» 0057 

* 1. INPUTS - XU...3) = l.,2.,3. Yd. ..3) = 2. ,4. ,6. 0058 

* IX(U..3) = 1,2,3 IY(U..3) = 2,4,6 Z = 0.0 0059 

* USAGE - CALL VTIMSV ( X, Y,3,X1) 0060 

* CALL XVTMSV ( IX, I Y, 3 , IX 1 ) 0061 

* CALL VTIMSV ( X, Y,3, Y) 0062 

* CALL XVTMSV (IX,IY,1,IX) 0063 

* CALL VTIMSV ( X, Y,0, Z) 0064 

* OUTPUTS - XI (1...3) = 2. ,8., 18. 1X1(1. ..3) = 2,8,18 0065 

* Y (1...3) = 2. ,8., 18. IX(1) = 2 0066 

* Z * 0.0 (NO OUTPUT CASE) 0067 
» 0068 

* PROGRAM FOLLOWS BELOW 0069 
« 0070 

* NO TRANSFER VECTOR 0071 

HTR 0 XR4 0072 

BCI 1, VTIMSV 0073 

* PRINCIPAL ENTRY. VT IMSV ( X, Y,LXY, XT IMSY ) 0074 
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VTIMSV 


CLA 
LDQ 


FMP 
NOP 








0075 
0076 


SETUP 


STO 
STQ 
SXD 


MLPLY 
VARY 

VTIMSV-2,4 








0077 
0078 
0079 


Kl 


CLA 










0080 




ADD 


Kl 


A(X)+l 






0081 




STA 


GET 








0082 




CLA 


2,4 








0083 




ADD 


Kl 


A(Y)+1 






0084 




STA 


MLPLY 








0085 




CLA 


4,4 








0086 




ADD 


Kl 


A(XTIMSY}+1 






0087 




STA 


STORE 








0088 




CLA* 


3,4 


LXY 






0089 




TMI 


LEAVE 








0090 




PDX 


0,4 








0091 




TXL 


LEAVE, 4,0 








0092 


» MULT 3 


[PLICATION LOOP 








0093 


GET 


LDQ 


**,4 


**=A(X)+1 






0094 


MLPLY 


NOP 




-FMP «*,4 OR 


MPY **,4 


*»=A(Y)+1 


0095 


VARY 


NOP 




=N0P OR ALS 


17 




0096 


STORE 


STO 
TIX 


*»,4 

GET, 4,1 


♦*=A(XTIMSY)+1 






0097 
0098 


• EXIT 












0099 


LEAVE 


LXD 
TRA 


VTIMSV-2,4 
5,4 








0100 
0101 


* SECOND ENTRY 


XVTMSVUX, 


IY,LXY,IXTMSY) 






0102 


XVTMSV 


CLA 
LDQ 
TRA 


MPY 
ALS 
SETUP 








0103 
0104 
0105 


* CONSTANTS 










0106 


FMP 


FMP 


**,4 








0107 


NOP 


NOP 










0108 


MPY 


MPY 


** v 4 








0109 


ALS 


ALS 

END 


17 








0110 
0111 



•»•»••••«•«»•»*»*««***•» PROGRAM LISTINGS 

* WAC * 4 WAC » 

• •»•»***••»«»••*«•*•**** ###*****»***♦**»«#.*«**♦♦ 



» WAC ISUBROUTINEI 9/29/64 LAST CARD IN DECK IS NO. 0082 

* LABEL 0001 

CWAC 0002 

SUBROUTINE WAC (LY,Y,LA,AI 0003 

C 0004 

C —ABSTRACT 0005 

C 0006 

C TITLE - WAC 0007 

C WIENER AUTOCORRELATION 0008 

C 0009 

C WAC FINDS THE AUTQCGRRELAT ION, A, OF AN ARBITRARY NUMBER 0010 

C OF LAGS t LA, FOR A SERIES, Y, OF LENGTH, LY 0011 

C 0012 

C LY 0013 

C Ad) = SUM Yt J)»Y( J + I-l) I=l,2t...tLA 0014 

C J=l 0015 

C 0016 

C WHERE WE ASSUME Y TO BE ZERO OUTSIDE THE RANGE *0R 0017 

C WHICH IT IS SPECIFIED. 0018 

C 0019 

C LANGUAGE - FORTRAN SUBROUTINE 0020 

C EQUIPMENT - 709 OR 7090 0021 

C STORAGE - 107 REGISTERS 0022 

C SPEED - 0023 

C AUTHOR - J.F. CLAERBOUT 0024 

C 0025 

C USAGE 0026 

C 0027 

C TRANSFER VECTOR CONTAINS ROUTINES - NONE 0028 

C AND FORTRAN SYSTEM ROUTINES - NONE 0029 

C 0030 

C FORTRAN USAGE 0031 

C CALL WAC ILY,Y,LA t A) 0032 

C 0033 

C INPUTS 0034 

C Yd) 1 = 1. ..LY IS THE SERIES TO BE AUTOCORRELATED. 0035 

C MUST BE FLOATING POINT. 0036 

C 0037 

C LY IS FORTRAN INTEGER 0038 

C MUST BE GRTHN=1. 0039 

C 0040 

C LA IS LENGTH OF THE DESIRED AUTOCORRELATION. 0041 

C IS FORTRAN INTEGER 0042 

C MUST BE GRTHN=1. 0043 

C MAY BE GRTHN LY. 0044 

C 0045 

C OUTPUTS 0046 

C Ad) 1 = 1. ..LA IS THE AUTOCORRELATION. 0047 

C A(l) = AUTOCORRELATION AT ZERO LAG. 0048 

C All) = 0. FOR I GRTHN LY. 0049 

C 0050 

C EXAMPLES 0051 

C 0052 

C 1. INPUTS - LY = 3 Yd. ..3) * l.,2.,3. LA * 1 0053 

C 0054 

C OUTPUTS - Ad) = 14. 0055 

C 0056 

C 2. INPUTS - SAME AS EXAMPLE 1. EXCEPT LA * 3 0057 

C 0058 

C OUTPUTS - Ad.*.3) = 14., 8., 3. 0059 

C 0060 

C 3. INPUTS - SAME AS EXAMPLE 1. EXCEPT LA = 5 0061 

C 0062 

C OUTPUTS - Ad. ..5) * 14., 8., 3., 0., 0. 0063 

C 0064 

DIMENSION YClOOl, A(IOO) 0065 

MM=XMI NOF ( LYf LA ) 0066 

DO 20 1=1, MM 0067 

Ad)=0. 0068 

L=LY-I+1 0069 

DO 10 J=1,L 0070 

K=J + I 0071 

Ad )=Ad )+Yt J)*Y(K-1) 0072 

10 CONTINUE 0073 

20 CONTINUE 0074 
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C IF (LA GRTHN LY) f WE MUST FILL SOME ZEROS IN A 0075 

IF (LA-LY) 50,50,30 0076 

30 NP * LY+i 0077 

DO 40 I=NP,LA 0078 

A(I)=0, 0079 

40 CONTINUE 0080 

50 RETURN 0081 

END 0082 



»•*•»*•«•**•*#*••*•***** PROGRAM LISTINGS 

* WHERE * 
•••••* •««••«• »*••*•*»**» 

REFER TO 

LOCATE 



#*«*••**«•*«*«»**«*•••»* 

♦ WHERE * 
#»**«#*••***•«••**•**••• 

REFER TO 

LOCATE 



••»«•»•»•«•«*»«»**•*••*» PROGRAM LISTINGS *»*#*#♦*»**#*##*♦#«*♦*** 

* WHICH » # WHICH » 

»*••*••«*••«*»•*•**••••* ******•»***«**•«»***•»** 



• 


WHICH 


C FUNCTIONS) 9/4/64 


LAST 


CARD IN DECK IS 


NO. 0076 


• 


FAP 










0001 


♦WHICH 










0002 




COUNT 


100 








0003 




LBL 


WHICH 








0004 




ENTRY 


WHICH Ft XI, X2,ZIFX1) 








0005 




ENTRY 


XWHICH FUX1,IX2,ZIFIX1) 








0006 


* 












0007 


* 












0008 


* 




ABSTRACT 








0009 


• 












0010 


• 


TITLE - WHICH, WITH SECONDARY ENTRY XWHICH 








0011 


• 


CHOOSE BETWEEN TWO VARIABLES BY A THIRD 


ONE BEING 


ZERO 


0012 


• 












0013 


• 




WHICH IS A FUNCTION WITH VALUE EQUAL TO 


ITS 


FIRST 


0014 


* 




ARGUMENT IF ITS THIRD ARGUMENT IS 


ZERO 


IN MAGNITUDE. 


0015 


• 




OTHERWISE WHICH HAS VALUE EQUAL TO 


ITS 


SECOND ARGUMENT. 


0016 


* 












0017 


• 




XWHICH IS THE FIXED POINT NAME FOR 


WHICH. 




0018 


• 












0019 


* 


LANGUAGE 


- FAP FUNCTIONS (FORTRAN II COMPATIBLE) 






0020 


• 


EQUIPMENT 


- 709 OR 7090 1 MAIN FRAME ONLY) 








0021 


* 


STORAGE 


- 4 REGISTERS 








0022 


• 


SPEED 


- 5 TO 7 MACHINE CYCLES 








0023 


* 


AUTHOR 


- S.M. SIMPSON, APRIL 1964 








0024 


# 












0025 


• 












0026 


• 




- USAGE 








0027 


* 












0028 


* 


TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 








0029 


* 


AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 








0030 


* 












0031 


• 


FORTRAN USAGE 








0032 


• 


X » WHICHF( XI, X2,ZIFX1) 








0033 


* 


IX=XWHICHF(IX1,IX£,ZIFIX1) 








0034 


• 












0035 


* 












0036 


* 


INPUTS 










0037 


• 












0038 


* 


X1*X2 


ARE FLOATING POINT. 








0039 


• 












0040 


• 


1X1,1X2, 


ARE FIXED POINT. 








0041 


• 












0042 




ZIFX1 


*0. IF XI IS TO BE CHOSEN. 








0043 


• 




NOT=0. IF X2 IS TO BE CHOSEN. 








0044 


• 












0045 


• 


ZIFIX1 


=0 IF 1X1 IS TO BE CHOSEN. 








0046 


• 




NOT=0 IF 1X2 IS TO BE CHOSEN. 








0047 


• 












0048 


* 












0049 


* 


OUTPUTS 










0050 


• 












0051 


• 


X OR IX 


IS SET AS OESCRIBED IN ABSTRACT. 








0052 


• 












0053 


• 












0054 


• 


EXAMPLES 










0055 


* 












0056 


* 


1. USAGES 


XA = WHICHF(1.,2.,0.) 








0057 


* 




XB = WHICHF (l.,2.,l.) 








0058 


* 




XC * WHICHF( 1.,2.,-137) 








0059 


• 




IXA * XWHlCHF(l,2,-0> 








0060 


* 




IXB * XWHICHFC I, 2, -.0001) 








0061 


* 




IXC = XWHICHF< 1,2,36) 








0062 


* 


OUTPUTS 


- XA = 1.0 XB = 2.0 XC * 2.0 








0063 


• 




IXA « I IXB = 2 IXC = 2 








0064 


* 












0065 


* 












0066 


• 


PROGRAM FOLLOWS BELOW 








0067 


• 












0068 


* 


NO TRANSFER 


VECTOR 








0069 


* 


BCI 


1, WHICH 








0070 
0071 


WHICH BSS 


0 








0072 


XWHICH ZET 


32765 * 77775 OCTAL 








0073 




XCA 










0074 
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TRA 1,4 

END 



0075 
0076 
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» WLLSFP ( SUBROUTINE ) 

» LABEL 
: WLLSFP 

SUBROUTINE WLLSFP ( LR, R , G, L A, A, C ) 
ABSTRACT 



10/6/64 LAST CARD IN DECK IS NO. 



TITLE - WLLSFP 

WIENER— LE VINSON LEAST SQUARE ERROR FILTER OR PREOICTOR 

WLLSFP FINDS SOLUTIONS FOR A CLASS OF SIMULTANEOUS 
EQUATIONS WHICH ARISE IN MANY LEAST SQUARE ERROR FILTERING 
AND PREDICTION PROBLEMS • SPECIFICALLY IT SOLVES THE 
FOLLOWING EQUATIONS FOR AA(I), I=0,1,...,M 



SUM { AA(N)«RR(K-N) ) 

N»0 



GG(K) K=0,1,« 



m , M 



GIVEN ANY RIGHT HAND SIDE GGU), I=0,1,.*.,M 
AND GIVEN ANY VECTOR RRU), 1=0, 1,...,M, M+l 
WHICH IS SYMMETRIC ( RR ( I ) » RRI-I)) 
AND FOR WHICH THE (M+1)*(M+1) TOEPLITZ MATRIX 
RR(K-N) K=0,1,...,M 
N*0,1,...,M 
IS POSITIVE DEFINITE. 

IN TIME SERIES PROBLEMS AA ( I ) IS A SET OF OPTIMUM FILTER 
COEFFICIENTS » RRU) IS AN AUTOCCRRELATION FUNCTION OR A 
SUM OF AUTOCORRELATION FUNCTIONS, AND GG{ I ) IS A CROSS- 
CORRELATION (OF INPUT WITH DESIRED OUTPUT). 

A SOLUTION IS ACCOMPLISHED BY A RECURSIVE PROCESS GIVEN 

BY N. LEVINSON IN APPENDIX B OF THE BOOK 

WIENER , N. , 1949, EXTRAPOLATION, INTERPOLATION, AND 

SMOOTHING OF STATIONARY TIME SERIES, JOHN WILEY AND 

SONS, INC., NEW YORK, PP 129-139. 



AN ADDITIONAL OUTPUT OF WLL 
CC(I), I=0,1,...,M (DEFINED 
EQUATIONS 17, 18). IT IS I 
THE EXTRA VALUE OF RR (I*E. 
THE SOLUTION FOR AA IS UNAF 
HOWEVER IF THE (M+2)*(M+2) 
IS ALSO POSITIVE DEFINITE, 
INTERPRETATION. IN THIS CAS 
THE M+l TERM LEAST SQUARES 
OPERATOR FOR ANY TIME SERIE 
FUNCTION (THRU LAG M+l) EQU 



SFP IS AN AUXILIARY SEQUENCE 

BY LEVINSON PAGE 137, 
N THE COMPUTATION OF CC THAT 

RR ( M+l ) ) IS REQUIRED. 
FECTED BY THE CHOICE OF R(M*11* 
MATRIX R(K-N) I K, N*0^ I , . * j , M+ll 
THEN CC HAS AN IMPORTANT 
E CC IS THE TIME REVERSE OF 
UN IT-PREDICT ION— DISTANCE 
S WHOSE AUTOCORRELATION 
ALS RR<0,l,.W.,M*l>. 



LANGUAGE 
EQUIPMENT 
STORAGE 
SPEED 

AUTHOR 



WLLSFP PROVIDES A REENTRY OPTION ALLOWING EFFICIENT 
RECURSION TO LARGER EQUATION SETS. 

FORTRAN II 

709 OR 7090 (MAIN FRAME ONLY) 
216 REGISTERS 

ABOUT 60<M«*2) MACHINE CYCLES 

WHERE M IS THE LENGTH OF THE A-VECTOR. 
R.A. WIGGINS, 9/28/62 



USAGE 

TRANSFER VECTOR CONTAINS ROUTINES - 
AND FORTRAN SYSTEM ROUTINES - 

FORTRAN USAGE 

CALL WLLSFP ( LR, R, G, L A, A, C ) 



FDOTR, FDOT, MOVE 
NONE 



INPUTS 
R(I ) 
G(I ) 



I=1...LR,LR+1 CONTAINS THE VECTOR RR(0, 1, ...,LR ) 
1*1. ..LR CONTAINS GGI 0 , 1, . . . , LR-1 ) 



0263 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008" 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
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LR 
LA 



IS FORTRAN II INTEGER, GRTHN=2. 



MUST LIE IN THE RANGE 2,...,LR OR -2, . . . ,-LR + 1 
IF LA 6RTHN=2, LA STANDS FOR THE DESIRED LENGTH OF THE 

FILTER, I.E. LA=M+1 
IF LA LSTHN=-2, WLLSFP ASSUMES THAT THIS IS A REENTRY 
CALL AND THAT THE USER WISHES TO EXTEND THE PREVIOUS 
FILTER WHOSE LENGTH WAS = MAGNITUDE (LA) TO A NEW 
FILTER OF GREATER LENGTH = LR, I.E. THE NEW M=LR~1. 
IN THIS CASE AU...LLA) AND C(1...LLA) WHERE LLA * 
MAGNITUDE (LA) MUST NOT HAVE BEEN DISTURBED FOLLOWING 
THE PREVIOUS CALL. 
IS FORTRAN II INTEGER 

C(I> I=1.*.2«LR IS ERASABLE COMPUTATION SPACE NEEDED BY WLLSFP 

OUTPUTS 

LA 

AU ) 
CU> 

EXAMPLES 

1. INPUTS - LR - 3 LA = 2 

R(1...3) = 1.25,0.5,0. GU...3J * i.,0.,0. 

OUTPUTS - A<1. ..2) = 0.95238, -0.38095 LA = 2 

2. INPUTS - SAME AS EXAMPLE 1. (AFTER EXAMPLE 1. IS COMPUTED) 

EXCEPT LA = -2 

OUTPUTS - A(1...3> = 0.98824, -0.47059, 0.18824 LA = 3 

3. EXAMPLE OF USE OF WLLSFP TO CONSTRUCT A LEAST SQUARE REALIZABLE 

FILTER WHICH, WHEN CONVOLVED WITH A SPECIFIED SIGNAL, WILL RESULT 
IN A DESIRED OUTPUT SIGNAL (USING SUBROUTINES QACORR AND QXCORR). 



IS SET EQUAL TO LENGTH OF A, SEE INPUT. 
IS FORTRAN INTEGER 

1= 1 ... LA CONTAINS THE SOLUTION VECTOR AA< 0* 1 , . . . ,M*LA-1 ) 

1=1. ..LA WILL CONTAIN THE LEVINSON AUXILIARY SEQUENCE 
CCIOUf .*.,LA-1=M) 



INPUTS 



USAGE 



- LET S(I), 1=1, LS BE THE INPUT SIGNAL 

D(I), 1=1, LS BE THE DESIRED OUTPUT 



FORM THE AUTOCORRELATION OF THE SIGNAL 

CALL QACORR (S ,LS,MXACC, LA, SPACE, R, IANS1I 

FORM THE CROSSCORRELATION OF THE DESIRED OUTPUT 
WITH THE SIGNAL. NOTE THAT ONLY HALF OF THE 
CROSSCORRELATION FORMED BY QXCORR IS NEEDED BY 
WLLSFP. 



OUTPUTS 



CALL QXCORR t S , D, LS, MXACC, LA, SPACE, G, I ANS2 ) 

C 

C FORM THE DESIRED FILTER 

C 

CALL WLLSFP ( LA, R ,G< L A+ I ) , L A, A r SPACE ) 
A(I), 1=1, LA IS THE DESIRED FILTER. 



4. EXAMPLE OF USE OF WLLSFP TO CONSTRUCT A LEAST SQUARE REALIZABLE 

FILTER WHICH, WHEN CONVOLVED WITH A SIGNAL PLUS NOISE, WILL 

RESULT IN THE NOISE BEING SUPRESSED AND THE SIGNAL SHAPE BEING 
CHANGED TO A DESIRED OUTPUT. 

INPUTS - LET SU), 1 = 1, LS BE THE INPUT SIGNAL 

XNU), 1 = 1, LN BE A SAMPLE OF THE NOISE 
DU>, 1 = 1, LS BE THE DESIRED OUTPUT 



USAGE 



FORM THE AUTOCORRELATION VECTOR R. 

CALL QACORR (S, LS, MXACC, LA, SPACE, AUTOS, IANSii 
CALL QACORR ( XN, LN, MX ACC, LA, SPACE , AUTON, JANS 2 3 
DO 10 1=1, LA 



0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
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C 10 RU) = AUTOS(I) + AUTONU) 0149 

C C 0150 

C C FORM THE CROSSCORREL AT ION VECTOR G. { SEE COMMENT 0151 

C C IN EXAMPLE 3.) 0152 

C C 0153 

C CALL QXCORR i S, 0, LS, MXACC, LA, SPACE, G, IANS3) 0154 

C C 0155 

C C FORM THE DESIRED FILTER 0156 

C C 0157 

C CALL WLLSFP {LA, R,G(LA+1) , LA, A, SPACE J 0158 

C 0159 

C OUTPUTS - Ad), 1 = 1, LA IS THE DESIRED FILTER. 0160 

C 0161 

C 5. EXAMPLE OF USE OF WLLSFP TO FORM A LEAST-SQUARE PREDICTION FILTER* 0162 

C 0163 

C INPUTS - LET S(I), 1=1, LS BE A SIGNAL WAVELET 0164 

C NP BE THE PREDICTION DISTANCE 0165 

C 0166 

C USAGE - C FORM THE AUTOCORRELATION VECTOR R. 0167 

C C 0168 

C MXLAG=L A+NP-1 0169 

C CALL QACORR ( S,LS, MXACC, MXLAG, SPACE, R, IANSU 0170 

C C 0171 

C C FORM THE PREDICTION ERROR FILTER WITH PREDICTION 0172 

C C DISTANCE NP=1. 0173 

C C 0174 

C IG=NP+1 0175 

C CALL WLLSFP ( L A , R , Rt I G) , LA, A, SP ACE ) 0176 

C C 0177 

C 0178 

C OUTPUTS - AU), 1 = 1, LA IS THE DESIRED FILTER. 0179 

C 0180 

C 6. EXAMPLE OF USE OF WLLSFP TO FACTOR A TIME SERIES, THAT IS, TO 0181 

C FINC THE LEAST SQUARE MINIMUM PHASE WAVELET ASSOCIATED WITH 0182 

C A SERIES. 0183 

C 0184 

C INPUTS - LET Xtl), 1=1, LX BE THE SERIES TO BE FACTORED* 0185 

C 0186 

C USAGE - C FORM THE AUTOCORRELATION VECTOR R. 0187 

C C 0188 

C CALL QACORR ( X,LX, MXACC, LA, SPACE, R, I ANSIS 0189 

C C 0190 

C C FORM THE CROSSCORREL AT ION VECTOR G. 0191 

C C 0192 

C GU) = 1. 0193 

C DC 10 1=2, LA 0194 

C 10 G ( I ) = 0. 0195 

C C 0196 

C C FORM THE PREDICTION ERROR FILTER LA. 0197 

C C 0198 

C CALL WLLSFP {LA, R, G, LA, A, SPACE ) 0199 

C C 0200 

C C FORM THE MINIMUM PHASE WAVELET XMW. 0201 

C C 0202 

C CALL POLYDV { L A, A , 1 , 1 . , LXMW, XMW ) 0203 

C 0204 

C OUTPUTS - XMW(I), 1=1, LXMW IS THE MINIMUM PHASE WAVELET. 0205 

C A(I), 1=1, LA IS THE PREDICTION ERROR FILTER WITH 0206 

C PREDICTION DISTANCE 1. 0207 

C 0208 

C 0209 

C 0210 

C PROGRAM FOLLCWS BELOW. 0211 

C 0212 
DIMENSION RC10)*GI10),A(10),CC20) 0213 

C 0214 

C REDEFINE INPUT CONSTANTS WHICH ARE USED A LOT 0215 
LR1=LR 0216 
N=2 0217 
LA1=LA 0218 
R1=R<1) 0219 

C 0220 

C SET UP THE MCDE OF OPERATION DEFINED BY LA 0221 
IF(LAl) 10,220,30 0222 

10 N=XABSFI LAI ) +1 0223 
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GO TO 75 
30 LR1=LA1 

C 

C SET UP INITIAL VALUES OF C, A, AND E. 

40 A(1)-G(1)/R1 
CU)^R(2)/R1 
75 LR2=LR1+1 

C 

C DO THE RECURSIONS 

C***»* 

DO 200 M=N f LRl 
Ml * M-l 

C 

C FORM THE NEXT A(,K) VECTOR 

CALL FDOTR ( M I , A , R ( 2 ) , C2 ) 
CALL FDOTR ( Ml ,G » R < 2 ) , C3 ) 

1 A(M)=(G(M)-C2)/(R1-C3) 
C * 

DO 100 K=1,M1 
100 A(K)=A{K)-C(K)»A(M) 
C « 
C 

C FORM THE NEXT C VECTOR 

CALL FOOT (Ml,C»R<2)tC2) 

2 C(LR2) a (R(M+l>-C2)/(Rl-C3) 
C * 

DO 150 K=2 f M 

K1=M-K 

K2=K+LR1 

150 C(K2)=C(K-l)-C(LR2)*C<Kl+l) 
C * 

CALL MOVE <M,C(LR2),C) 

C 

200 CONTINUE 
C*«*»* 
C 

C SET OUTPUT PARAMETERS 

210 LA=M1+1 
220 RETURN 
END 
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0224 
0225 
0226 
0227 
0228 
0229 
0230 
0231 
0232 
0233 
0234 
0235 
0236 
0237 
0238 
0239 
0240 
0241 
0242 
0243 
0244 
0245 
0246 
0247 
0248 
0249 
0250 
0251 
0252 
0253 
0254 
0255 
0256 
0257 
0258 
0259 
0260 
0261 
0262 
0263 
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» WRTDAT (SUBROUTINE) 9/8/64 LAST CARD IN DECK IS NO. 0125 

* FAP 0001 
♦WRTDAT 0002 

COUNT 100 0003 

LBL WRTDAT 0004 

ENTRY WRTDAT 1 1 TAPE, DAT A, LDATA, I ANS ) 0005 

» 0006 

* ABSTRACT 0007 

* 0008 

* TITLE - WRTDAT 0009 
» WRITE BINARY DATA ON TAPE 0010 
» 0011 
» WRTDAT WRITES A BINARY RECORD FROM A FORTRAN VECTOR ON A 0012 
» SPECIFIED OUTPUT TAPE. ERROR RETURNS INDICATE IF A 0013 

* REDUNDANCY OR END-TAPE CONDITION WAS FOUND* NO SUM-CHECK 0014 

* IS PROVIDED. 0015 
» 0016 

* LANGUAGE - FAP SUBROUTINE (FORTRAN II COMPATIBLE) 0017 

* EQUIPMENT - 709, 7090, 7094 (MAIN FRAME AND TAPE UNIT) 0018 

* STORAGE - 77 REGISTERS 0019 

* SPEED - (PRIMARILY CONTROLLED BY DATA-CHANNEL TIMING) 0020 

* AUTHOR - R.A. WIGGINS JULY, 1964 0021 
» 0022 

* USAGE 0023 

* 0024 

* TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0025 
» AND FORTRAN SYSTEM ROUTINES - UOS), (TCO), (WRS)# IRGHJ, { TRC I t 0026 
» ( ETT ) 0027 
» 0028 

* FORTRAN USAGE 0029 

* CALL WRTDAT < I TAPE,DATA,LDATA, I ANS ) 0030 

* 0031 

* INPUTS 0032 
» I TAPE LOGICAL OUTPUT TAPE NUMBER. 0033 

* MUST BE GRTHN* 1, LSTHN= 20 0034 
« 0035 

* DATA ( I ) 1=1,... ,LDATA IS A DATA VECTOR (IN ANY MODE) TO BE 0036 

* WRITTEN. 0037 
» 0038 

* LDATA LENGTH OF DATA VECTOR. 0039 
» MUST BE GRTHN= 1 0040 

* 0041 

* OUTPUTS 0042 

* 0043 
» IANS =0 IF ALL OK. 0044 

* =2 IF A REDUNDANCY IS ENCOUNTERED. 0045 

* =3 IF AN END-TAPE MARK IS ENCOUNTERED. 0046 

* *-l IF IT APE LSTHN 1 OR GRTHN 20 0047 

* =-2 IF LDATA LSTHN I 0048 

* 0049 

* EXAMPLE 0050 

* 0051 
» 1. CONSTRUCTION OF A FORTRAN STYLE BINARY RECORD 0052 

* INPUTS - ITAPE * 5 DAT AC 1 ... 3 ) = OCT 00000200000 1, 123456123456, 0053 

* 654321654321 LDATA = 3 0054 
» USAGE - CALL WRTDAT ( I TAPE, DAT A, LDATA, IANS ) 0055 

* BACKSPACE ITAPE 0056 

* READ TAPE ITAPE, ( DAT IN ( I ) , I* 1 ,2 ) 0057 

* OUTPUTS - IANS * 0 DATINU...2) * OCT 123456123456, 654321654321 0058 
» 0059 
» PROGRAM FOLLOWS BELOW 0060 

* 0061 
XR4 HTR 0 0062 

BCI 1, WRTDAT 0063 

WRTDAT SXD XR4,4 0064 

SXA XRl,i 0065 

SXA XR2,2 0066 

CLA» 3,4 0067 

TZE IANM2 0068 

TMI IANM2 0069 

PDX ,1 0070 

CAL 2,4 0071 

STA UT 0072 

LDQ =20B17 0073 

CLA» 1,4 0074 
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TZE 


IANM1 




TMI 


IANM1 




TLQ 


I ANM1 




ADD 


=020 




TSX 


$( I0S>,4 




LXD 


XR4,4 




LDQ* 


$(TCC) 




SLQ 


TCOA 




SLQ 


TC0A1 




LDQ» 


$( WRS) 




STQ 


WRSA 




LDQ* 


$(*CH) 




SLO 


RCHA 




XCL 






ADD 


-0000400000000 




XCL 






SLQ 


LCHA 




LDQ* 


$(TRC) 




SLQ 


TRCA 




LDQ* 


$ ( ETT ) 




SLQ 


ETTA 


TCOA 


TCOA 


• 


URSA 


WTDA 


»» 


RCHA 


RCHA 


UT 




TRA 


INC 


LCHA 


LCHA 


UT 


INC 


CAL 


UT 




SUB 


= 1835 




SLW 


UT 




TIX 


LCHA, 1,1 


TCOA1 


TCOA 


* 


TRCA 


TRCA 


I AN2 


ETTA 


ETTA 






TRA 


I AN3 




IOT 






NOP 






CLA 


=0 


RETURN 


STO* 


4,4 


XRI 


AXT 


**# I 


XR2 


AXT 


**,2 




TRA 


5,4 


IANM1 


CLS 


= 1B17 




TRA 


RETURN 


IANM2 


CLS 


=2B17 




TRA 


RETURN 


IAN2 


CLA 


=2B17 




TRA 


RETURN 


IAN3 


CLA 


= 3B17 




TRA 


RETURN 


UT 


I OCT 
END 


#*, ,1 
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0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
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* XACTEQ ( FUNCTION ) 9/4/64 LAST CAftD IN DECK IS NO. 0075 

* FAP 0001 
•XACTEQ 0002 

COUNT 50 0003 

LBL XACTEQ 0004 

ENTRY XACTEQ F(X,Y) 0005 

» 0006 

* 0007 
» ABSTRACT 0008 

* 0009 

* TITLE - XACTEQ 0010 

* SIGN OF DIFFERENCE OF 2 VARIABLES OR 0 IF SAME INCLUDING SIGN 0011 

* 0012 

* XACTEQ TAKES THE DIFFERENCE BETWEEN TWO VARIABLES OF ANY 0013 

* MODE AND RETURNS -1 OR +1 AS THE SIGN OF THE DIFFERENCE, 0014 

* OR +0 IF THE TWO VARIABLES ARE EXACTLY EQUAL, INCLUDING 0015 

* SIGNS, (+0 IS CONSIDERED GREATER THAN -0) 0016 

* 0017 

* LANGUAGE - FAP FUNCTION ( FORTRAN- I I COMPATIBLE) 0018 

* EQUIPMENT - 709 OR 7090 I MAIN FRAME ONLY) 0019 

* STORAGE - 11 REGISTERS 0020 
» SPEED - 6 OR 10 MACHINE CYCLES 0021 

* AUTHOR - S.M.SIMPSON, JR. APRIL 1964 0022 

* 0023 

* 0024 

* USAGE 0025 

* 0026 

* TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0027 

* AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0028 

* 0029 

* FORTRAN USAGE 0030 

* I XMY=XACTEQF ( X , Y ) 0031 

* 0032 

* 0033 

* INPUTS 0034 

* 0035 

* X IS ANY MODE. 0036 
» 0037 
» Y IS ANY MODE. 0038 

* 0039 

* 0040 

* OUTPUTS 0041 

* 0042 
» IXMY = 0 IF 8ITS S,1...35 OF X ARE EXACTLY IDENTICAL TO 0043 

* BITS S,1...35 OF Y. 0044 

* * +1 IF X IS GREATER THAN Y. 0045 

* = -1 IF X IS LESS THAN Y. 0046 
» 0047 

* 0048 

* EXAMPLES 0049 

* 0050 

* I. INPUTS - XU...5) = l.,0.,-0.,0.,0. IX(1...5) » 1^0,-0,0,0 0051 

* Yd. ..5) = 0.,-0.,0.,0., 1. IYU...5) » 0,~0,0,Otl 0052 

* USAGE - DO 10 1=1,5 0053 

* IXMY1(I)=XACTEQF(X(I),Y(I)> 0054 

* 10 IXMY2( I )-XACTEQF( IX( I),IY( I) ) 0055 

* OUTPUTS - IXMYK1...5) = +1, +1, -1, 0, -1 0056 
» IXMY2U...5) = +1, +1, -1, 0, -1 0057 

* 0058 

* 0059 

* 0060 

* PROGRAM FOLLOWS BELOW. 0061 

* 0062 

* 0063 
BCI 1, XACTEQ 0064 

XACTEQ TLQ ABIGRQ 0065 

XCA 0066 

TLQ Q8IGRA 0067 

PXD 0,0 0068 

TRA 1,4 0069 

ABIGRQ CLA KD1 0070 

TRA 1,4 0071 

CBIGRA CLS KD1 0072 

TRA 1,4 0073 

KD1 PZE 0,0,1 0074 

END 0075 
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PROGRAM LISTINGS 



**»******««»**•*»•**«»«* 

* XADDK * 
**#♦*##»*♦*»##***♦*♦**»* 

REFER TO 
AODK 



•»»*»*»•••*••*******»**» 

• XADDKS * 
»**«*#*#♦*«*#♦•#*#»*#*** 

REFER TO 
ADDK 



•»•*•«»»*•»***•*»•»**»»» 

* XADOKS * 
****«*«»***«•*•*»••*«•** 

REFER TO 
ADDK 



•••*•**«*»*****#*•••«*»* 

* XARG » 



REFER TO 
LOCATE 



«*#**«••«*•««*•**»«*»*»* 

* XARG * 
**#«»** ##•»«*•«•*«****»• 

REFER TO 

LOCATE 



•«••»*•»«»*•«-»*•»*••»**« 
* XAVRGE * 
*#*»**♦»##«**#»*»♦*#*#■§* 



PROGRAM LISTINGS 



*«*»****#»» 
# XAVRGE » 
##*#*#*»*»####«*»*»*♦»** 



* XAVRGE (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO* 0103 

* FAP 0001 
♦XAVRGE 0002 

COUNT 150 0003 

LBL XAVRGE 0004 

ENTRY XAVRGE 1 1 X , L IX , IX AVG ) 0005 

ENTRY XAVRGR I IX, LIX, IXAVG) 0006 

* 0007 
« ABSTRACT 0008 

* 0009 

* TITLE - XAVRGE WITH SECONDARY ENTRY XAVRGR 0010 
» FIND AVERAGE OF FIXED PT VECTOR 0011 

* 0012 

* XAVRGE FINDS THE MEAN, TRUNCATED TO A FORTRAN- 1 1 INTEGER, 0013 
» OF A GIVEN FXD VECTOR. OVERFLOW CAN NOT OCCUR* 0014 

* XAVRGR FINDS THE ROUNDED MEAN. 0015 

* 0016 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN— 1 1 COMPATIBLE) 0017 

* EQUIPMENT - 709 OR 7090 {MAIN FRAME ONLY) 0018 

* STORAGE - 34 REGISTERS 0019 

* SPEED - 7090 709 0020 

* XAVRGE 80 OR 87 + 11*LX MACHINE CYCLES, 0021 

* XAVRGR 84 OR 91 + 11*LX LX = VECTOR LENGTH 0022 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 0023 

* 0024 

* USAGE 0025 

* 0026 
» TRANSFER VECTOR CONTAINS ROUTINES - XDIV,XDIVR 0027 

* AND FORTRAN SYSTEM ROUTINES - i NONE ) 0028 

* 0029 

* FORTRAN USAGE 0030 

* CALL XAVRGE C IX, LIX, IXAVG) 0031 

* CALL XAVRGRCIX,LIX, IXAVG) . 0032 

* 0033 

* INPUTS 0034 

* 0035 

* IXU) 1 = 1. ..LIX IS A FXD VECTOR 0036 
» 0037 
» LIX SHOULD EXCEED ZERO 0038 

* 0039 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LIX LSTHN 1 0040 

* 0041 
» IXAVG WILL = (1/LIX) » SUM (FROM 1 = 1 TO LIX) OF IXtU, 0042 

* TRUNCATED TO INTEGER (XAVRGE) OR ROUNDEC (XAVRGRI 0043 

* 0044 
» THE SUMMATION IS CARRIED OUT IN A MANNER WHICH AVOIDS 0045 

* OVERFLOW 0046 

* 0047 
» EXAMPLES 0048 
« 0049 
» 1. INPUTS - IX( 1...4)=1,2,3,4 0050 
» IY( U ..4)^90000,91000,92000,93000 0051 
« IU=0 0052 
« USAGE - CALL XAVRGE ( I X ,4, IXAV 1 ) 0053 

* CALL XAVRGR( IX, 4, IXAV2) 0054 

* CALL XAVRGR { IX(2),3, IXAV 3) 0055 

* CALL XAVRGE( IY,4, IXAV4) 0056 
» CALL XAVRGE ( IX, 1, IXAV5) 0057 
» CALL XAVRGE( IX, 0, IU ) 0058 
» OUTPUTS - IXAV1=2 IXAV2=3 IXAV3=3 IXAV4=91500 0059 
» IXAV5=l IU=0 (NO OUTPUT CASE) 0060 

* 0061 
« PROGRAM FOLLOWS 8EL0W 0062 

* 0063 

* TRANSFER VECTOR HAS XDIV,XDIVR (FUNCTIONS) 0064 

HTR 0 XR1 0065 

HTR 0 XR4 0066 

BCI 1, XAVRGE 0067 

* PRINCIPAL ENTRY. XAVRGE( IX , LIX, IXAVG) 0068 
XAVRGE CLA DIV 0069 

SETUP STO VARY 0070 

SXD XAVRGE-3,1 0071 

SXD XAVRGE-2,4 0072 

Kl CLA 1,4 0073 

ADD Kl A(IX)+1 0074 



**••••*«*•*»*•*•*****»#* PROGRAM 
» XAVRGE * 
**«**•«•*«•«**•*»***•»•* 

(PAGE 2) 



LISTINGS *♦##»##*.*»#*♦*#*♦♦♦♦*♦»» 

# XAVRGE * 

•»***»**•***••*•• 

(PAGE 2) 





STA 


GET 




0075 




CLA* 


2,4 


LIX 


0076 




ARS 


18 




0077 




TMI 


LEAVE 




0078 




PAX 


0,1 




0079 




TXL 


LEAVE, 1,0 




0080 




XCA 




SAVE LIX IN MQ 


0081 


* SUM 


IX(1 


*..LIX) IN ADDRESS 


OF AC 


0082 




STZ 


SUM 




0083 


GET 


CLA 


**t i 


*»=A( 1X3+1 


0084 




ARS 


18 




0085 




ADD 


SUM 




0086 




STO 


SUM 




0087 




TIX 


GET, 1,1 




0088 


* FIND 


THE 


AVERAGE (LIX STILL 


IN MQ ADDRESS) 


0089 


VARY 


TSX 




*»=$XDIV OR SXDIVR 


0090 


» STORE AND 


LEAVE 




0091 




LXD 


XAVRGE-2,4 




0092 




STO* 


3,4 




0093 


LEAVE 


LXD 


XAVRGE-3,1 




0094 




TRA 


4,4 


IXAVG 


0095 


« SECOND ENTRY. X AVRGR ( I X , L I X 


,IXAVG) 


0096 


XAVRGR 


CLA 


DIVR 




0097 




TRA 


SETUP 




0098 


« CONSTANTS 


, VARIABLES 




0099 


DIV 


TSX 


$XDIV,4 




0100 


DIVR 


TSX 


$XDIVR,4 




0101 


SUM 


PZE 


»» 


SUMMATION 


0102 




END 






0103 



*••#*«•••«•»******•**•»* PROGRAM LISTINGS * *##*#***#*•***♦»#*♦»##» 

• XAVRGR * * XAVRGR » 

**••**#•»••**•****•**•** #••*»«•«•*••***•»•**••»* 

REFER TO REFER TO 

XAVRGE XAVRGE 



» XBOOST * » XBOOST 

REFER TO REFER TO 

BOOST BOOST 



* XCMPRA ♦ 
•«••**••*••»*»**•••***»* 



REFER TO 
CMPRA 



«•*•»*»****••••••***»»*» 

* XCMPRA * 
*«•••»»***•»»••***••**** 

REFER TO 
CMPRA 



**###»»»#»*#*#**#*#»*»** 

» XDANL * 
•*»•••»»***««***•»•»**•« 

REFER TO 
ADANL 



» XDANL « 
#»*»*♦**#♦»»**#»♦*»*#*** 

REFER TO 
ADANL 



***•*»*»***«**»•»*«•**«* 

* XDANX « 
«»*•*#»»*»»#***»**»♦*♦** 

REFER TO 
ADANL 



* XDANX » 
**•»*»«•****»*•*•*•#«»«* 

REFER TO 
ADANL 



* XDELTA * 
»****•*»•»****»***••***• 

REFER TO 
DELTA 



*••#•*••**»***»*******•* 

* XDELTA , * 

•***•*»•»««•*»*»»*»*•*** 

REFER TO 
DELTA 



*»**»«••*»••••»«•**«•»*# 

♦ XDFPRS * 
•****•»*•*•*****»*•*•*•* 

REFER TO 

DIFPRS 



* XDFPRS • 
*»*•*••**»***•***»•**••* 

REFER TO 
DIFPRS 



••*»»•««••***»••*#»•***# PROGRAM LISTINGS < ♦.»#***#•#♦#»##»•*»«##** 

* XOIV • # XOIV * 

*•*«*•*»*•»****•»#••»*** «»«*•**••*«•»*•»*»*•**#• 



»XDIV 



XDIV 
FAP 

COUNT 
LBL 
ENTRY 
ENTRY 



(FUNCTION) 



100 
XDIV 

XOIV F( NUMERA, IDENOM) 

XDIVR F(NUMERA, IDENOM) 



9/29/64 LAST CARD IN DECK IS NO. 



ABSTRACT 

TITLE - XDIV WITH SECONDARY ENTRY XDIVR 

FXD PT DIVIDE WITH TRUNCATION OR ROUNDING TO FORTRAN— I I INTEGER 

XDIV IS A FUNCTION WHOSE VALUE IS THE RATIO OF ITS T*IO 
FIXED FCINT ARGUMENTS, TRUNCATED AS A FORTRAN— f I INTEGER* 

XDIVR IS IDENTICAL EXCEPT THAT THE RESULT IS ROUNDED* 



* LANGUAGE 
» EQUIPMENT 
» STORAGE 

* SPEED 



AUTHOR 



- FAP FUNCTIONS ( FORTRAN-I I COMPATIBLE) 

- 709 OR 7090 (MAIN FRAME ONLY) 

- 27 REGISTERS 

- XDIV TAKES 35(7090) OR 42(709) MACHINE CYCLES 
XDIVR TAKES 52(7090) OR 59(709) MACHINE CYCLES 

- S.M. SIMPSON, AUGUST 1963 

«* USAGE 



* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 
* 

* FORTRAN USAGE 

* IQUOT a XDIVF (NUMERA, IDENOM) 
» IQUOT » XDI VRF (NUMERA, I DENOM) 
• 

* INPUTS 

* NUMERA 



IS ANY FXD.PT. NO. 



IDENOM IS ANY NON-ZERO FXD.PT. NO. WITH THE SAME BINARY POINT 
AS NUMERA. 



OUTPUTS 



IQUOT 



» EXAMPLES 



- IF IDENOM » 0 PROGRAMS RETURN WITH NO ACTION (AC AND 
MQ ARE LEFT AS IS) SO THAT THE EFFECTIVE VALUE OF THE 
FUNCTION WILL BE = NUMERA. THE MQ IS ALWAYS RESTORED 
TO * IDENOM. 

WILL EQUAL NUMERA/ I DENOM, TRUNCATED (XDIV) OR ROUNDED 

(XDIVR) TO A FORTRAN II INTEGER. 
WILL * NUMERA IF IDENOM - 0 

OVERFLOW CAN NOT OCCUR IF THE INPUTS ARE FORTRAN— 1 1 
INTEGERS. NO OVERFLOW TEST IS MADE. 



OUTPUTS - IQ10 = OCT 000002000000 



» PROGRAM FOLLOWS BELOW 



0108 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 



• 


1. USAGE 




1Q1 = XDIVF 


( 1, 4) 


0056 


* 






IQ2 « XDIVF 


{ 2* 4) 


0057 


• 






IQ3 * XDIVF 


( 4, 4) 


0058 


• 






IQ4 = XDIVF 


( 9, 4) 


0059 


» 






IQ5 « XDIVRF 


( 1, 4) 


0060 


• 






IQ6 * XDIVRF 


( 2, 4) 


0061 


• 






IQ7 - XDIVF 


( 1,-1) 


0062 


• 






IC8 = XDIVRF 


(-1, 1) 


0063 


* 






IQ9 = XDIVF 


( 3, 0) 


0064 


• 


OUTPUTS 


IQ1 = 0 


IQ2=0 IQ3=1 


IQ4=2 


0065 


* 




IQ5=0 


IQ6=1 IQ7=- 


1 IQ8=-l 


0066 


• 




109 = 3 


(DIVISION BY 


ZERO) 


0067 


* 










0068 


• 


2. INPUTS 


- X » OCT 0000000000 11 Y = OCT 000000000004 


0069 


* 


USAGE 




IQ10 = XDIVF 


(X,Y) 


0070 



0071 
0072 
0073 
0074 



»*»#•*•••»•*•«**•*•****« 
* XDIV * 



(PAGE 2) 



PROGRAM LISTINGS 



if •»*»*•#** ****** ******** 
# XDIV * 
*»•«#**•••••*•#*«***»**» 

(PAGE 2) 



» NO TRANSFER VECTOR 



♦ PRINCIPAL ENTRY* XDIVFINUMERA, IDENOM) 



0075 
0076 
0077 



XDIV 


STQ 


TEMP 


SAVE IDENOM 


0078 




LDQ 


XCA 


SET FOR TRUNCATION 


0079 


SETUP 


STQ 


VARY 




0080 




NZT 


TEMP 


ZERO DENOMINATOR CHECK 


0081 




TRA 


LEAVE 




0082 




LRS 


35 


0 IN AC, NUMERA IN MQ 


0083 




DVP 


TEMP 




0084 


VARY 


NOP 




* XCA OR TRA ROUND 


0085 


ALS 


ALS 


18 




0086 


LEAVE 


LDQ 


TEMP 


RESTORE IDENOM 


0087 




TRA 


It* 




0088 


* ROUNDING 


INSERT, COMPARES 


TWICE THE REMAINDER AGAINST IDENOM* 


0089 


ROUND 


SSP 






0090 




ALS 


1 


(OVERFLOW IMPOSSIBLE) 


0091 




SBM 


TEMP 




0092 




CLM 




PREPARE FOR ROUNDING DOWN 


0093 




TMI 


RXCA 


(SIGN BIT UNDISTURBED) 


0094 




CLA 


KRND 


PREPARE FOR ROUNDING UP 


0095 


RXCA 


XCA 






0096 




RND 






0097 




TRA 


ALS 




0098 


* SECOND ENTRY, XD I VRF ( NUMERA, IDENOM ) 


0099 


XDIVR 


STQ 


TEMP 


SAVE IDENOM 


0100 




LDQ 


RND 


SET FOR ROUNDING 


0101 




TRA 


SETUP 




0102 


» CONSTANTS 


, VARIABLES 




0103 


XCA 


XCA 






0104 


RND 


TRA 


ROUND 




0105 


KRND 


CCT 


200000000000 




0106 


TEMP 


PZE 


**,**, ** 


=: IDENOM 


0107 




END 






0108 



PROGRAM LISTINGS 



XDIVK 



REFER TO 
ADOK 



**•*****•*»•»»•*****«*** 

* XDIVK * 
••*•»**»•••»*•*»»**»**«* 

REFER TO 
ADDK 



*»****«**«»******«*»«**» 
* XDIVKS » 
***«*«**««»«**«******«*« 

REFER TO 
ADDK 



***«««***«***«,«**»«»««*» 

* XDIVKS * 
***««««*»««**«»*«*««*«** 

REFER TO 
ADDK 



*#♦«**#*»♦*#**♦*»#*#»#** 
* XDIVR * 
**•**•••«****••••»**«*•* 

REFER TO 
XDIV 



***«*•*«»#***•»**•*«**•• 

* XDIVR * 
4* «#«•«* ***•«*•»***«*•** 

REFER TO 
XDIV 



»**•*«*» 



XDPRSS 



REFJER TO 
BOOST 



***#**•*••**•••*«»•#»»»» 

♦ XDPRSS * 
#**#**«»****•*•«**«»*«»* 

REFER TO 
BOOST 



»••*•**»•««•«»**»*•***«* PROGRAM LISTINGS #*##***#*♦»#♦##»*#♦**»** 

« XDVIDE * 4 XDVIDE » 

***•*•*«•••*•**•*»**•*** *•*»*»#*****«••***»•#•* 



* XDVIDE (SUBROUTINE) 9/29/64 LAST CARD IU DECK IS NO* 0104 

* FAP 0001 
•XDVIDE 0002 

COUNT 150 0003 

LBL XDVIDE 0004 

ENTRY XDVIDE ( IX, LIX, IXDVSR, IXDVDD) 0005 

ENTRY XDVIDR ( IX. LIX, IXDVSR, IXDVDD] 0006 

» 0007 

* ABSTRACT 0008 

» 0009 

» TITLE - XDVIDE 0010 

* DIVIDE A FXD VECTOR BY A CONSTANT 0011 

* 0012 
» XDVIDE FORMS A VECTOR EQUAL TO A GIVEN VECTOR DIVIDED 0013 

* BY A FXD CONSTANT, TRUNCATING THE DIVISIONS* OUTPUT 0014 

* MAY REPLACE INPUT. 0015 
» 0016 
» XDVSR IS IDENTICAL EXCEPT IT ROUNDS THE DIVISIONS. 0017 

* 0018 
» LANGUAGE - FAP SUBROUTINES ( FORTRAN- I I COMPATIBLE) 0019 
» EQUIPMENT - 709 OR 7090 C MAIN FRAME ONLY) 0020 

* STORAGE - 33 REGISTERS 0021 

* SPEED - 7090 709 0022 

* XDVIDE 42 + (47 OR 54)*LX MACHINES CYCLES, 0023 

* XDVIDR 44 ♦ (49 OR 56)*LX LX * VECTOR LENGTH 0024 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 0025 

* 0026 

* ~ USAGE 0027 

* 0028 

* TRANSFER VECTOR CONTAINS ROUTINES - XDIV, XDIVR 0029 

* AND FORTRAN SYSTEM ROUTINES - i NONE) 0030 

* 0031 
» FORTRAN USAGE 0032 

* CALL XDVIDEtlX, LIX, IXDVSR, IXDVDD) 0033 

* CALL XDVIDR(iIX,LIX, IXDVSR, IXDVDD) 0034 

* 0035 

* INPUTS 0036 

* 0037 

* IXU) 1 = 1. • .LIX IS A FXD VECTOR 0038 

* 0039 

* LIX SHOULD EXCEED ZERO 0040 

* 0041 

* IXDVSR IS A NGN-ZERO FXD QUANTITY. EQUIVALENCE! IXDVSR, 0042 

* SOME IX(I)) IS PERMITTED. 0043 

* 0044 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUT IF LIX LSTHN 1 0R IXDVSR*0 0045 

* 0046 
« IXDVDDCI) 1 = 1. ..LIX HAS VALUES IXDVDDU ) = I X ( I ) / I XDVSR TRUNCATED 0047 

* TO INTEGERS (XDVIDE) OR ROUNDED TO INTEGERS (XDVIDR). 0048 

* EQUIVALENCE (IXDVDD, IX) IS PERMITTED. 0049 
» 0050 

* THE INITIAL VALUE OF IXDVSR IS ALWAYS USED AS THE DIVISOR 0051 

* 0052 
» EXAMPLES 0053 

* 0054 

* 1. INPUTS - IX(1...4)=1,2,3,4 IU=0 IV=0 0055 

* USAGE - CALL XDVIDE( IX, 4, 2, IY) 0056 
« CALL XDVIDR(IX,4,2,IZ) 0057 

* CALL XDVIDR( IX, 1,2, IW) 0058 

* CALL XDVIDRt IX, 0,2, IU) 0059 

* CALL XDVIDR( IX, 1,0, IV) 0060 

* CALL XDVIDR( IX,4,IX(3), IX) 0061 

* OUTPUTS - IYC 1... 4)^0, 1, 1,2 IZ ( 1 . . . 4) * 1, 1 , 2, 2 0062 
» IW=1 IU=IV=0 (NO OUTPUT CASES) IX( l...4)*0, 1, 1, 1 0063 

* 0064 

* PROGRAM FOLLOWS BELOW 0065 
» 0066 

* TRANSFER VECTOR HAS XDIV, XDIVR FUNCTIONS 0067 

HTR 0 XR1 0068 

HTR 0 XR4 0069 

BCI 1, XDVIDE 0070 

« PRINCIPAL ENTRY, XDVIDE! IX,LIX, IXDVSR, IXDVDD) 0071 

XDVIDE CLA DIV 0072 

SETUP STO VARY 0073 

SXD XDVIDE-3,1 0074 



*»••*•«*»**»«••»•*•**»#• PROGRAM 
* XDVIDE * 
**••#•***•••»••********* 

(PAGE 2) 



L I STINGS *»•*•***•-***•**••«••••*» 

♦ XOVIDE * 
*»«***»#*«***#********•• 

( PAGE 2) 



SXD 


XDV IDE-2 ,4 






0075 


Kl CLA 


1,4 






0076 


ADD 


Kl 


A( IX) + 1 




0077 


STA 


GET 






0078 


CLA 








0079 


ADD 


Kl 


A( IXDVDD>+1 




0080 


STA 


STORE 






008 1 


CLA* 


2,4 


LIX 




0082 


TMI 


LEAVE 






0083 


PDX 


0,1 






0084 


TXL 


LEAVE ,1,0 






0085 


CLA* 


3,4 


ZERO TEST FOR IXDVSR 


0086 


TZE 


LEAVE 






0087 


* DIVISION LOOP 






0088 


XCA 




IXDVSR (REMAINS IN 


MQ) 


0089 


GET CLA 


**, 1 


**=A( IX)+1 




0090 


VARY NOP 




=TSX $XDIV,4 OR 


TSX $XDIVR,4 


009 1 


STORE STO 


**tl 


**=A( IXDVDD3-H 




0092 


TIX 


GET, 1,1 






0093 


* EXIT 








0094 


LEAVE LXD 


XDVIDE-3,1 






0095 


LXD 


XDVIDE-2,4 






0096 


TRA 


5,4 






0097 


* SECONDARY 


ENTRY* XDV I DRt IX, L IX, 


IXDVSR, IXDVDD) 




0098 


XDVIDR CLA 


DIVR 






0099 


TRA 


SETUP 






0100 


* CONSTANTS 








0101 


DIV TSX 


$XDIV,4 






0102 


DIVR TSX 


$XDIVR,4 






0103 


END 








0104 



»•••*••****•»*******••*» 

* XDVIDR * 
••*••«••*••**»****•*«*»* 

REFER TO 

XDVIDE 



PROGRAM LISTINGS 



#«•**••#••*«*••&•**•*»«* 

# XDVIDR * 
»•••***«*** •*»•*«* 

REFER TO 
XDVIDE 



* XDVRK * 
**•*•*•**•*»«»»•«»*«***» 



REFER TO 
ADDK 



•***»*•»*»**»*»»•••*•»*» 

♦ XDVRK « 
**•***«»»«•»*«•»*«****** 

REFER TO 
ADDK 



«**«•••*****»*****»»•*** 

« XDVRKS * 
«»*#*«*»««»»*«*»»«**«*«• 

REFER TO 
ADDK 



*«*•*«**«««*«****»***«** 
« XDVRKS ♦ 
«**«*«•**«***»***« *•**»* 

REFER TO 
ADDK 



»•••**•»*«»*******•«•*** PROGRAM LISTINGS ##*##»it##*#itM#*****#*** 

* XFIXM * # XFIXM • 

**•«•*•»•*«»»••*******•» #•«**«•»#***••»•**«*•»»• 



XFIXM (FUNCTION) 
FAP 



9/29/64 



LAST CARD IN DECK IS NO, 



♦ XFIXM 



COUNT 100 
LBL XFIXM 

ENTRY XFIXM F<JOB,FLTG) 

• 

* —ABSTRACT 

« 

* TITLE - XFIXM 

* TRUNCATE OR ROUND FLOATING PT. NUMBER TO MACHINE INTEGER. 
* 

* XFIXM TRUNCATES OR ROUNDS A FLOATING POINT NUMBER TO A 

» FIXED POINT INTEGER WHOSE BINARY POINT IS TO THE RIGHT OF 

« BIT 35. FLOATING POINT NUMBERS WITH MAGNITUDES 

* EXCEEDING 2.**27-l. ARE TREATED AS THOUGH THEIR 

* MAGNITUDES EQUALLED 2.**27-l. 



LANGUAGE 

EQUIPMENT 

STORAGE 

SPEED 

AUTHOR 



FAP SUBROUTINE < FORTRAN II FUNCTION) 

709# 7090 (MAIN FRAME ONLY) 

31 REGISTERS 

ABOUT 35 MACHINE CYCLES 

S.M. SIMPSON JR. , NOV/1962 



— t — USAGE 



TRANSFER VECTOR CONTAINS ROUTINES 
AND FORTRAN SYSTEM ROUTINES 

FORTRAN USAGE 

INTEGR » XFIXMF <JOB,FLTG) 



NONE 
NONh 



* INPUTS 
* 

* JOB 
* 

» FLTG 
* 

* OUTPUTS 
* 

* INTEGR 
* 

* EXAMPLES 



=0 MEANS TRUNCATE 
NOT=0 MEANS ROUND TO NEAREST INTEGER 



IS A FLOATING POINT NUMBER. 



IS THE MACHINE LANGUAGE INTEGER EQUIVALENT TO FLTG. 
= PLUS OR MINUS OCT 000777777777 IF MAGNITUDE OF 
FLTG EXCEEDS 2.**27-i. 



XFIXM SXO 



XFIXM-2,4 



* CHECK MAGNITUDE OF FLTG 



STO 
STQ 
XCA 
SSP 
CAS 
NOP 
TRA 
OK, FIX IT 
CLA 



JOB 
FLTG 



LIMIT 

TOOBIG 
FLTG 



TOO BIG 
TOO BIG 



0097 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
002 3 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 



* 


1. 


INPUTS 




JOB = 0 


FLTG = 3.52 


0047 


• 




OUTPUTS 




INTEGR « 


OCT 000000000003 


0048 


• 












0049 


* 


2. 


INPUTS 




JOB * I 


FLTG = 3.52 


0050 


• 




OUTPUTS 




INTEGR « 


OCT 000000000004 


0051 


• 












0052 


• 


3. 


INPUTS 




JOB = 1 


FLTG * -3.52 


0053 


« 




OUTPUTS 




INTEGR = 


OCT 400000000004 


0054 


• 












0055 


* 


4. 


INPUTS 




JOB = 0 


FLTG = -1234567890. (EXCEEDS 2***27-1.) 


0056 


* 




OUTPUTS 




INTEGR = 


OCT 400777777777 


0057 


* 












0058 


• 


5. 


INPUTS 




JOB « 1 


FLTG « 1234567890. 


0059 


» 




OUTPUTS 




INTEGR * 


OCT 000777777777 


0060 


* 












0061 






HTR 




0 




0062 






BCI 




It XFIXM 




0063 



0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
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L I STINGS «##»♦* «*•*«« 

# XFIXM # 
*♦♦♦»#»»*#»#»#»**##♦»»»* 

(PAGE 2) 





UFA 


Kl 


0075 




LRS 


0 


0076 




ANA 


K2 


0077 




LLS 


0 


0078 


» CHECK FOR 


ROUNDING 


0079 




NZT 


JOB 


0080 




TRA 


LEAVE 


0081 




RQL 


8 


0082 




RND 




0083 


LEAVE 


TRA 




0084 


* CLIP 


BIG 


NUMBERS 


0085 


TOOBIG 


CLA 


FLTG 


0086 




TMI 


♦♦3 


0087 




CLA 


K2 


0088 




TRA 


LEAVE 


0089 




CLS 


K2 


0090 




TRA 


LEAVE 


0091 


LIMIT 


OCT 


234400000000 ( =2. »*27 ) 


0092 


Kl 


OCT 


233000000000 


0093 


K2 


OCT 


000777TT7777 


0094 


JOB 


PZE 


»• 


0095 


FLTG 


PZE 


** 


0096 




END 




0097 



•*••#••*•«*••**•••••»*** PROGRAM LISTINGS 

• XINOEX ♦ 

•*••#*•»**»•••••»*•»•*•* 

REFER TO 

LOCATE 



***•*•*•»•*•**•»•#«»»*«» 

* XINOEX * 
######•**#***#»#**•♦«##» 

REFER TO 
LOCATE 



****•»****««•»*•******•» PROGRAM LISTINGS #*♦«#»*#»##♦♦«*»»#»♦•*»* 

* XLCOMN * ♦ XLCOMN ♦ 

#**•«•*•**•*•*•*»******* <*#•#«♦#♦*•*♦##**♦«♦*#»♦* 

* XLCOMN (FUNCTION) 9/4/64 LAST CARD IN DECK IS NO. 0075 

* FAP 0001 
♦XLCOMN 0002 

COUNT 100 0003 

LBL XLCOMN 0004 

ENTRY XLCOMN F(ZIFACT) 0005 

* 0006 

* 0007 

« ABSTRACT — — 0008 

» 0009 

» TITLE - XLCOMN 0010 

* FIND LENGTH OF COMMON STORAGE 0011 

* 0012 

* XLCOMN EXAMINES OCTAL LOCATION 143 TO FIND EITHER THE 0013 

* LENGTH OF COMMON SPACE BEYOND THE LAST STORED ROUTINE, OR 0014 

* THE TOTAL LENGTH OF COMMON DIMENSIONED IN THE ROUTINES. 0015 

* 0016 
« UNDER THE FORTRAN MONITOR SYSTEM, OCTAL LOCATION 143 0017 

* CONTAINS THE ADDRESS OF THE FIRST UNUSED SPACE IN THE 0018 
» DECREMENT, AND THE ADDRESS OF THE LAST COMMON SPACE USED 0019 
» IN THE ADDRESS. 0020 

* 0021 

* LANGUAGE - FAP FUNCTION (FORTRAN II COMPATIBLE) 0022 
» EQUIPMENT - 709 OR 7090 1 MA IN FRAME ONLY) 0023 

* STORAGE - 14 REGISTERS 0024 

* SPEED - ABOUT 16 MACHINE CYCLES* 0025 

* AUTHOR - R.A. WIGGINS 4/64 0026 
« 0027 
» 0028 

* USAGE 0029 

* 0030 

* TRANSFER VECTOR CONTAINS ROUTINES - ( NOT ANY) 0031 

* AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0032 
» 0033 
« FORTRAN USAGE 0034 
» LCOMON « XLCOMNF(ZIFACT) 0035 
» 0036 

* 0037 

* INPUTS 0038 
» 0039 
» ZIFACT -0. IF ACTUAL LENGTH OF AVAILABLE COMMON FROM THE END OF 0040 

* THE STORED PROGRAMS THROUGH LOCATION 32561 IS 0041 

* DESIRED. 0042 

* NOT= 0. IF DIMENSIONED LENGTH OF COMMON IS DESIRED. 0043 

* 0044 

* 0045 

* OUTPUTS 0046 
» 0047 
» LCOMON IS LENGTH OF COMMON ACCORDING TO ZIFACT 0048 

* 0049 
« 0050 

* EXAMPLES 0051 
» 0052 

* I. INPUTS - SUPPOSE A MAIN PROGRAM AND A SET OF SUBROUTINES ARE 0053 

* LOADED INTO LOCATIONS 144 THROUGH 4114 (OCTAL) 0054 

* (2124 DECIMAL), AND THAT THE MAIN IS DIMENSIONED WITH 0055 

* COMMON STORAGE OF LENGTH 2000 (DECIMAL). 0056 

* USAGE - LC0MN1 = XLCOMN (0.) 0057 
» LC0MN2 = XLCOMN (1.) 0058 

* OUTPUTS - LCQMN1 = 30436 LC0MN2 = 2000 0059 

* 0060 
» 0061 

* PROGRAM FOLLOWS BELOW 0062 
» 0063 

BCI 1, XLCOMN 0064 

XLCOMN TZE Al 0065 

CLA 99 0066 

ANA =0000000777777 0067 

ALS 18 0068 

TRA Al+1 0069 

Al CLA 99 0070 

ANA =0777777000000 0071 

SSM 0072 

ADD =32561817 0073 

TRA 1,4 0074 

END 0075 



•***••»•**•*»***»»«*•••* PROGRAM LISTINGS * *»#***#***#•#*•*♦*«#»** 

* XtlMIT * * XLIMIT » 

•*•••«»*****••••*•*»«*** #*•«*»****#*»•••*»«**••• 



» XLIMIT ^FUNCTION) 9/4/64 LAST CARD IN DECK IS NO. OlOO 

» FAP 0001 

•XLIMIT 0002 

COUNT 100 0003 

LBL XLIMIT 0004 

ENTRY XLIMIT FIX, XA, XB) 0005 

* 0006 

* 0007 

» ——ABSTRACT 0008 

» 0009 

* TITLE - XLIMIT 0010 

* FIND IF ARGUMENT FALLS INSIDE TWO LIMITING VALUES 0011 

* 0012 
» XLIMIT HAS VALUE +0 IF ITS FIRST ARGUMENT LIES IN THE 0013 
« INCLUSIVE RANGE OEFINED BY ITS SECOND AND THIRD 0014 

* ARGUMENTS, HAS VALUE -1 IF ITS FIRST ARGUMENT IS LESS 0015 
» THAN THE SMALLER OF ITS OTHER TWO ARGUMENTS, OR *1 IF 0016 

* GREATER THAN THE LARGER OF THE OTHER TWO. THE MODE OF 0017 

* THE ARGUMENTS IS IMMATERIAL, AND +0 IS CONSIDERED EQUAL 0018 

* TO -0 IN THE COMPARISONS. 0019 
» 0020 
» LANGUAGE - FAP FUNCTION ( FORTRAN-I I COMPATIBLE) 0021 

* EQUIPMENT - 709,7090,7094 < MAIN FRAME ONLY) 0022 
» STORAGE - 25 REGISTERS 0023 

* SPEED - 21 TO 33 MACHINE CYCLES 0024 
» AUTHOR - S.M. SIMPSON, JUNE 1964 0025 

* 0026 

* 0027 
» USAGE 0028 

* 0029 
» TRANSFER VECTOR CONTAINS ROUTINES - NOT ANY 0030 

* AND FORTRAN SYSTEM ROUTINES - NOT ANY 0031 

* 0032 
» FORTRAN USAGE 0033 

* IZIFIN = XLIMITF<X,XA,XB) 0034 

* 0035 

* 0036 

* INPUTS 0037 

* 0038 

* X IS ANY MODE. 0039 

* 0040 

* XA IS SAME MODE AS X. 0041 
» 0042 

* XB IS SAME MODE AS X. 0043 

* 0044 

* 0045 
» OUTPUTS 0046 

* 0047 

* IZIFIN HAS VALUE 0,-1, +1 AS DESCRIBED IN ABSTRACT. 0048 
» 0049 

* 0050 
« EXAMPLES 0051 

* 0052 

* 1. USAGE - IZFIN1 = XLIMITF<3,2,4) 0053 

* IZFIN2 = XLIMITFt 2,2,4) 0054 

* IZFIN3 = XLIMITF(4,2,4) 0055 
» IZFIN4 = XLIMITFi-0,+0,4) 0056 

* IZFIN5 = XLIMITFI +0,-0,4) 0057 

* IZFIN6 = XLIMITFI *0,-2,-0) 0058 

* IZFIN7 = XLIMITF(-0,-2,+0) C059 

* IZFIN8 = XLIMITFI 1,2,4) 0060 

* IZFIN9 = XLIMITFI5,2,4) 0061 
» OUTPUTS - IZFIN1...IZFIN9 = 0 , 0, 0, 0, 0, 0, 0,-1, +1 0062 

* 0063 

* 2. USAGE - SAME AS EXAMPLE 1. BUT WITH THE THREE FUNCTION ARGUMENTS 0064 

* FLOATING POINT. 0065 

* OUTPUTS - SAME AS EXAMPLE 1. 0066 

* 0067 

* 3. USAGE - SAME AS EXAMPLE 1. BUT WITH REVERSED ORDER OF THE SECOND 0068 

* AND THIRD ARGUMENTS. 0069 
» OUTPUTS - SAME AS EXAMPLE 1. 0070 

* 0071 
» 0072 

* PROGRAM FOLLOWS BELOW. 0073 

* 0074 
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BCI 


1 f XLIMIT 






0075 


XLIMI T 


STO 


TEMP 


FORCE XLO 




0076 




CLA 


32765 


INTO MQ, 




0077 




TLQ 


»+2 


XHI INTO XHI 




0078 




XCA 








0079 




STO 


XHI 






0080 




CLA 


TEMP 


AND RESTORE X 




008 1 




TNZ 


XCA 






0082 




SSP 




(ADJUST FOR ZERO AMBIGUITY) 




0083 


XCA 


XCA 








0084 




TLQ 


CLS1 


BAD IF X LSTHN XLO 1+0 IS GRTHN* + OR 


-01 


0085 




XCA 








0086 




TNZ 


LDQ 






0087 




SSM 




{ READJUST ) 




0088 


LDQ 


LDQ 


XHI 






0089 




TLQ 


CLA1 


BAD IF XHI LSTHN X {♦ OR -0 IS 6RTHN* 


-01 


0090 




PXO 


0,0 






0091 




TRA 


1,4 






0092 


CLS1 


CLS 


KD1 






0093 




TRA 


1,4 






0094 


CLA1 


CLA 


KD1 






0095 




TRA 


1,4 






0096 


KD1 


PZE 


0,0,1 






0097 


XHI 


PZE 


«*,•«,** 






0098 


TEMP 


PZE 


»* y •* v ** 






0099 




END 








0100 



• »*»««•*•«*****»«•»••*** PROGRAM LISTINGS •••**•••*•* 

* XLOCV » f XLOCV * 
**•»*•#«•**«*»*•*•»«»•** «*»#«•*•»***»«•»•«**«»•* 

* XLOCV (SUBROUTINE) 9/4/64 LAST CARO I» DECK IS NO. 0099 

* FAP 0001 
♦XLOCV 0002 

COUNT 100 0003 

LBL XLOCV 0004 

ENTRY XLOCV IL0CV,X1,X2, ...,XN) 0005 

» 0006 

* 0007 
« * ABSTRACT — <~ 0008 

* 0009 
« TITLE - XLOCV 0010 

* CREATE VECTOR OF MACHINE ADORESSES OF VARIABLES IN A LIST 0011 

* 0012 

* XLOCV IS A VARIABLE LENGTH— CALL ING-SEQUENGE SUBROUTINE 0013 

* WHOSE FIRST ARGUMENT IS ITS OUTPUT AND IS A VECTOR OF 0014 

* FORTRAN-I I INTEGERS GIVING THE MACHINE ADDRESSES OF ITS 0015 

* REMAINING ARGUMENTS. 0016 

* 0017 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN— I I COMPATIBLE) 0018 
» EQUIPMENT - 709, 7090, 7094 (MAIN FRAME ONLY) 0019 

* STORAGE - 24 REGISTERS 0020 
» SPEED - ABOUT 15 ♦ 20*N MACHINE CYCLES ON THE 7090 0021 

* WHERE N+l IS THE ARGUMENT COUNT. 0022 

* AUTHOR - S.M. SIMPSON, FEBRUARY 1964 0023 

* 0024 

* 0025 

* USAGE 0026 

* 0027 

* TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0028 
» AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0029 
» 0030 

* FORTRAN USAGE 0031 

* CALL XL0CV(L0CV,Xl,X2,..„,XN) 0032 

* 0033 

* 0034 
» INPUTS 0035 
« 0036 

* XI ARGUMENT WHOSE MACHINE ADDRESS IS TO BECOME LOCVtl) 0037 

* X2 ARGUMENT WHOSE MACHINE ADDRESS IS TO BECOME L0CV(2J 0038 

* ETC 0039 

* XN ARGUMENT WHOSE MACHINE ADDRESS IS TO BECOME LOCV(N) 0040 
» N SHOULD EXCEED ZERO 0041 

* 0042 

* 0043 
« OUTPUTS 0044 

* 0045 
« LOCV(I) 1=1. ..N CONTAINS THE MACHINE ADDRESSES OF Xl^.JXN 0046 

* 0047 

* 0048 

* EXAMPLES 0049 
» 0050 
« 1. INPUTS - SUPPOSE X IS A VECTOR EQUIVALENT TO THE COMMON BLOCK 0051 

* (AT 32561 BASE 10) 0052 
» USAGE - CALL XL0CV( L0CV1 , X( I) ,X( 10) , X( 7) ) 0053 

* CALL XL0CV(L0CV2,X) 0054 

* OUTPUTS - L0CV1U...3) ^ 32561, 32552, 32555 L0CV2( 11=32561 0055 

* 0056 

* 0057 

* PROGRAM FOLLOWS BELOW 0058 

* 0059 
HTR 0 XR1 0060 
HTR 0 XR4 0061 
BCI 1, XLOCV 0062 

* 0063 
» ONLY ENTRY, XLOCV ( LCCV ,X1 , X2, ... .,XN ) 0064 
» 0065 

XLOCV SXD XLOCV-3,1 0066 

SXD XLOCV-2,4 0067 

CLA 1,4 A(LOCV) 0068 

STA STO 0069 

AXT 0,1 0070 

» 0071 

* GET NEXT ARGUMENT AND TEST FOR A TSX X,0 0072 

* 0073 
CAL CAL 2,4 PICKS UP TSX XI, 0 FIRST 0074 
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L I STINGS <»»•«**•»***•##•»•»»•»»» 
* XLOCV * 
#*##*•*•*•***•«**«••**** 
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STA TEMP 0075 

ANA AMASK 0076 

LAS TSXZ 0077 

TRA *+2 NO 0078 

TRA STORE YES 0079 

* 0080 
» EXIT 0081 

* 0082 
LXD XLOCV-3,1 NO 0083 
TRA 2,4 0084 

» 0085 

* STORE AN AOORESS ANO GO BACK FOR ANOTHER 0086 

* 0087 
STORE CLA TEMP 0088 

ALS 18 0089 

STO STO «»,1 *« = A(LOCV) 0090 

TXI *+l,l,l 0091 

TXI CAL,4,-1 0092 

* 0093 
» CONSTANTS, TEMPORARIES 0094 

* 0095 
AMASK OCT 777777700000 0096 
TSXZ TSX 0,0 0097 
TEMP PZE ** *« = POSSIBLE ADDRESS 0098 

END 0099 



» • ♦#« • • »#»» «»* ft -ft »* ftp • • # « 

» XLSHFT * 



REFER TO 
LSHFT 



PROGRAM LISTINGS 



«•*»»•*••••*»*••**«»»*»• 

* XLSHFT » 
**•«*»««•«««•*»»«••*»•** 

REFER TO 
LSHFT 



••••»».*•••»•»•*•»**•#*•• 

» XML PLY * 
•*»•*'-## tf • 

REFER TO 

MULPLY 



*»*#••*••*«••«• »***••«*• 

* XMLPLY * 
**•#»«*•»•««•••••••«•*»• 

REFER TO 
MULPLY 



»•*••**•»••»•••»•»•»*•« 

» XMULK 



REFER TO 
ADDK 



»**•*«««»*•*••»«**•*«•*» 

■• XMULK * 



REFER TO 
ADDK 



*«*«««•«***»**««« **»*«»« 

* XMULKS « 



REFER TO 
ADDK 



«•*«♦«»*»♦«♦♦»*♦*«»»♦♦«* 

* XMULKS » 
»»*»»«»*♦»»*•»*»«***»*♦* 

REFER TO 
ADDK 



• XNAME ♦ 
•»**••#»•«••***»*•»*»•#» 

REFER TO 

LOCATE 



* •*•*•«* » •*«»**••* 

# XNAME ♦ 
#♦»#♦**»«•-»♦»♦»*»♦♦♦♦■»** 

REFER TO 
LOCATE 



XNARGS 



REFER TO 
LOCATE 



**••*•••»•«•***»««*»*•«• 

* XNARGS * 
4 «***«*•«»«• »***»«***«»» 

REFER TO 

LOCATE 



»*••*««•••«•**«*•»*•**** ^ftftft»»»» »* *»»•»«»« 

» XNTHA « * XNTHA * 

»••**•••••••«»•••**••»*• 4 ••#*«•**«•••*« ***«••*«* 

REFER TO REFER TO 

NTHA NTHA 



* XNTSUM * 
»•••**»«*«*»*«•«-«•*»*•** 

REFER TO 

INTSUM 



♦♦•♦ftftftftftft * ♦♦♦»#»«♦*»♦♦♦ 

• XNTSUM » 

• ftftftftftftftftftftftftftftftftftftftftftft* 

REFER TO 

INTSUM 



»*»»*»*»»#♦«*♦*♦*#«»#**# PROGRAM LISTINGS 

» XOOZE * * XOOZE » 

••••»«**•***•*•«*•*»*•«* «*•*••*»**«***#••****#»* 



» XOOZE (FUNCTION) 9/4/64 LAST CARD III DECK IS NO. 0060 

» FAP 0001 

♦XOOZE 0002 

COUNT 50 0003 

L8L XOOZE 0004 

ENTRY XOOZE F(INT) 0005 

* 0006 

* 0007 

* ABSTRACT 0008 

» 0009 

* TITLE - XOOZE 0010 

* DETERMINE WHETHER FORTRAN— I I INTEGER IS EVEN OR ODD 0011 

* 0012 
» XOOZE FUNCTION RETURNS 1 IF ITS ARGUMENT IS 000, ZERO IF 0013 
« EVEN. 0014 

* 0015 
» 0016 

* LANGUAGE - FAP FUNCTION ( FORT RAN- 1 1 COMPATIBLE! 0017 
» EQUIPMENT - 709,7090,7094 (MAIN FRAME ONLY) 0018 
» STORAGE - 4 REGISTERS 0019 
« SPEED - 4 MACHINE CYCLES 0020 

* AUTHOR - S.M.SIMPSON,JR. APRIL 1964 0021 

* 0022 

* 0023 
» USAGE 0024 

* 0025 
» TRANSFER VECTOR CONTAINS ROUTINES - (NOT ANY) 0026 

* AND FORTRAN SYSTEM ROUTINES - (NOT ANY) 0027 

* 0028 

* FORTRAN USAGE 0029 
» IZIFEV=XOOZEFUNT) 0030 

* 0031 
» 0032 
» INPUT 0033 

* 0034 
» INT IS A FORTRAN— 1 1 INTEGER 0035 
» 0036 

* 0037 

* OUTPUT 0038 

* 0039 
» IZIFEV = 0 IF INT IS EVEN 0040 
» = 1 IF INT IS ODD 0041 
» 0042 
» 0043 
» EXAMPLES 0044 
» 0045 

* 1. USAGE DIMENSION IZIFEV(9) 0046 
» DO 10 1=1,9 0047 

* 10 1ZIFEV( I) = X00ZEFU-5) 0048 

* OUTPUTS - IZIFEVU...9) « 0,1,0,1,0,1,0,1,0 0049 

* 0050 

* 0051 
« 0052 

* PROGRAM FOLLOWS BELOW 0053 

* 0054 
» 0055 

BCI 1, XOOZE 0056 

XOOZE ANA MASK 0057 

TRA 1,4 0058 

MASK OCT 000001000000 0059 

END 0060 



••»**«•«•#**••*#»*••*»«• PROGRAM LISTINGS 

* XREMAV » 4 XREMAV * 

*•»***•**•••«**•**•»•**« *•***•»•»«*»••*»*•»««»«• 



« XREMAV 1SUBROUT INE ) 9/29/64 LAST CARD IN DECK IS NO. 0111 

* FAP 0001 
•XREMAV 0002 

COUNT 100 0003 

LBL XREMAV 0004 

ENTRY XREMAV ( IX, LIX, IXAVG, IXNULD) 0005 

* 0006 

* -* ABSTRACT 0007 

* 0008 

* TITLE - XREMAV 0009 

* REMOVE THE MEAN FROM A FIXEO VECTOR 0010 

* 0011 

* XREMAV COMPUTES THE AVERAGE VALUE OF A FIXEO PQINT 0012 
» VECTOR (ROUNDING THE AVERAGE TO NEAREST INTEGER) J AND 0013 
» THEN SETS AN OUTPUT VECTOR WITH ELEMENTS EQUAL TO THOSE 0014 

* OF THE INPUT VECTOR MINUS THE AVERAGE. THE OUTPUT 0015 
» VECTOR MAY REPLACE THE INPUT VECTOR. THE AVERAGE IS 0016 
» ALSO AN OUTPUT QUANTITY. 0017 
« 0018 

* THERE IS NO DANGER OF FIXED POINT OVERFLOW* 0019 

* 0020 

* LANGUAGE - FAP SUBROUTINE ( FORTRAN—I I COMPATIBLE) 0021 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0022 
» STORAGE - 31 REGISTERS 0023 

* SPEED - 125 + 19*L MACHINE CYCLES ON 7090, L * VECTOR LENGTH 0024 

* 132 + 19*L MACHINE CYCLES ON 709 0025 

* AUTHOR - S.M. SIMPSON, SEPTEMBER 1963 0026 
» 0027 

» USAGE 0028 

» 0029 

* TRANSFER VECTOR CONTAINS ROUTINES - XAVRGR 0030 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0031 

* 0032 
» FORTRAN USAGE 0033 
» CALL XREMAVCIX, LIX, IXAVG, IXNULD) 0034 
» 0035 
» INPUTS 0036 

* 0037 

* IXU) 1 = 1.. .LIX IS A FIXED VECTOR IMUST BE FORTRAN— 1 1 INTEGERSl 0038 

* 0039 
» LIX SHOULD EXCEED ZERO C040 
» 0041 

* OUTPUTS STRAIGHT RETURN WITH NO OUTPUTS IF LIX LSTHN 1J 0042 

* 0043 

* IXAVG IS = (1/LIX) * ( SUM(FROM 1=1 TO LIX) OF XII) H 0044 
» ROUNDED TO NEAREST INTEGER. IT IS COMPUTED IN 0045 
» A MANNER WHICH ELIMINATES THE POSSIBILITY OF 0046 
» FIXED POINT OVERFLOW. 0047 

* 0048 

* IXNULDCI) 1 = 1.. .LIX IS IXNULDII) = IXC II - IXAVG 0049 

* 0050 
» EQUIVALENCE(IXNULD,IX) IS PERMITTED* 0051 

* 0052 

* EXAMPLES 0053 

* I. INPUTS - 1X1(1. 5) = 90000, 91000, 92000, 93000, 94000 0054 
» 1X2(1. ..5) = I, 2, 3, 4, 5 0055 

* IXAVG6 = IXNLD6 = -999 0056 
» 0057 
» USAGE - CALL XREMAV ( 1X1, 5, IXAVG1, IXNLD1) 0058 
» CALL XREMAVUX2, 5, IXAVG2, IXNLD2) 0059 

* CALL XREMAVUX2, 4, IXAVG3, IXNLD3) 0060 
» CALL XREMAVUX2, 5, IXAVG4, 1X2) 0061 
» CALL XREMAVUXl, 1, IXAVG5, IXNLD5) 0062 

* CALL XREMAVUXl, 0, IXAVG6, IXNLD6) 0063 
« 0064 

* OUTPUTS - IXAVG1 « 92000 IXNLDK 1. . . 5) * -2000,-1000,0,1000,2000 0065 

* IXAVG2 « 3 IXNLD2( 1...5) = -2, -1, 0, 1, 2 0066 
» IXAVG3 = 3 IXNLD3J 1...43 = -2, -1, 0, 1 0067 

* I XAVG4 = 3 1X2(1. ..5) = -2, -1, 0, 1, 2 0068 
» IXAVG5 = 90000 IXNLD5U) = 0 0069 
» IXAVG6 = IXNLD6 = -999 (NO OUTPUT CASE) 0070 
» 0071 

* PROGRAM FOLLOWS BELOW 0072 
» 0073 

* 0074 
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• TRANSFER VECTOR CONTAINS XAVRGR( IX, LIX, IXAVG) 





HTR 


0 


XR4 




BCI 


If XREMAV 




* ONLY 


ENTRY. 


XREMAVtlX tLIX 


, IXAVG, IXNULD) 


XREMAV 


SXD 


XREMAV-2, 4 




Kl 


CLA 


It* 


A< IX) 




STA 


TSXl 






ADD 


Kl 


AUX> + 1 




STA 


GET 






CLA 


3,4 


A( IXAVG) 




STA 


TSX3 






STA 


SUB 






CLA 


4,4 






ADD 


Kl 


AC IXNULD5+1 




STA 


STORE 






CLA* 


2,4 


LIX 




TMI 


LEAVE 






STD 


LIX 






NZT 


LIX 






TRA 


LEAVE 




* COMPUTE IXAVG 






TSX 


$XAVRGR,4 




TSX1 


TSX 


**#0 


»«=A{ IX) 




TSX 


LIX,0 




TSX3 


TSX 


**40 


***A< IXAVG) 


• MEAN 


REMOVAL 


LOOP 






LXD 


LIX, 4 




GET 


CLA 


»*,4 


**=A( IX) + 1 


SUB 


SUB 


** 


»»=A( IXAVG) 


STORE 


STO 


**,4 


**=A< IXNULD)+i 




TIX 


GET, 4,1 




» EXIT 








LEAVE 


LXD 


XREMAV-2, 4 






TRA 


5,4 




» TEMPORARY 






LIX 


PZE 


0,0, »» 


♦«=LIX 




END 
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0075 
0076 
0077 
0076 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
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# XRFLEC » 
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REFER TO 

REFLEC 
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* XSAME * 
*••#•*«»»*•**••#**»*••*» 

REFER TO 
SAME 
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# XSAME » 
«•#«•**••#•••****••*»••* 

REFER TO 
SAME 



* XSMDEV » 
****•••***•*•*»*#•*•*••* 

REFER TO 

SUMOFR 
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REFER TO 
SUMDFR 
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REFER TO 

SUMDFR 
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REFER TO 
SUMDFR 
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» XSPECT tSUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO, 0238 

* LABEL 0001 

CXSPECT 0002 
SUBROUTINE XSPECT I XCOR, N,COSTAB, SINTAB, M» JMIN* JMAX, €SP* SSPi 0003 
1 SPACE, ERR) 0004 

C 0005 

C — ABSTRACT 0006 

C 0007 

C TITLE - XSPECT 0008 

C FAST COSINE, SINE TRANSFORMS OF CROSS-CORRELATION FUNCTIONS 0009 

C 0010 

C XSPECT PRODUCES A HI— SPEED CROSS^POWER COR ENERSY1 DENSITY 0011 

C SPECTRUM (OR PORTION THEREOF) FROM AN N-LAG CROSS- 0012 

C CORRELATION FUNCTION, XCU) I=-N,-N+l, . • . ,N , IN TERMS 0013 

C OF THE REAL AND IMAGINARY PARTS 0014 

C 0015 

C N 0016 

C CS(J) * SUM { XC(I)*COS(I«J»PI/M) ) 0017 

C I=-N 0018 

C 0019 

C N 0020 

C S3(J) * SUM ( XC( I)*SIN( I»J»PI/M) ) 0021 

C I=-N 0022 

C 0023 

C FOR J = JMIN, JMIN+i,-.., JMAX 0024 

C WHERE 0025 

C PI = 3,14159265 0026 

C N,M,JMIN AND JMAX ARE INPUT PARAMETERS 0027 

C COS(J*PI/M) AND SIN(J*PI/M) J=0,l,..,^M ARE 0028 

C REQUIRED AS INPUT TABLES 0029 

C 0 LSTHN* JMIN LSTHN JMAX LSTHN- M 0030 

C 0031 

C SPEED IS ATTAINED BY 0032 

C 1. (FOR M LSTHN= N) 0033 

C -COLLAPSING XC( I) INTO THE RANGE -M TO *M 0034 

C -SPLITTING THE COLLAPSED CORRELATION INTO ODO AND 0035 

C EVEN PARTS AND RESPL ITTING THESE INTO THEIR 0036 

C ODD AND EVEN SUBPARTS. 0037 

C 0038 

C 2. USING THE HI-SPEED LOOPING LOGIC OF SUBROUTINE 0039 

C COSISP TO PERFORM THE TRANSFORMS OF THE SHORTENED 0040 

C SUBPARTS I LENGTH » M/2) 0041 

C 0042 

C 2«M+4 TEMPORARY REGISTERS ARE NEEDED UNLESS USER IS 0043 

C WILLING TO SACRIFICE THE CROSS-CORRELATION FOR SCRATCH 0044 

C (TEMPORARIES NOT REQUIRED IF M GRTHN N) 0045 

C 0046 

C LANGUAGE - FORTRAN II SUBROUTINE 0047 

C EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0048 

C STORAGE - 523 REGISTERS 0049 

C SPEED - FOR M LSTHN= N - 36»( JMAX-JM IN* 1 ) *M MACHINE CYCLES 0050 

C FOR M GRTHN N - 72* ( JMAX-JM IN+1 ) *N MACHINE CYCLES 0051 

C AUTHOR - S.M. SIMPSON JR,, NOV 1961 0052 

C 0053 

C USAGE 0054 

C 0055 

C TRANSFER VECTOR CONTAINS ROUTINES - SPLIT, COSISP, REFIT, KOLAPS, 0056 

C CHPRTS 0057 

C AND FORTRAN SYSTEM ROUTINES - XLOC 0058 

C 0059 

C FORTRAN USAGE 0060 

C CALL XSPECT ( XCOR, N > COST AB, S INTAB,M, JMIN, JMAX,CSP , SSP, SPACE, ERR) 0061 

C 0062 

C INPUTS 0063 

C 0064 

C XCOR(I) I=-N+l#...,N+l CONTAINS XC(J) J= -N,.*.,N RESPECTIVELY 0065 

C (THIS FORMAT PLACES THE ZERO LAG CORRELATION, 0066 

C XC<0>, IN XCOR(l) 0067 

C 0068 

C N MUST EXCEED ZERO 0069 

C 0070 

C COSTAB(I) 1=1.*. M+l CONTAINS COS(J*PI/M) J=0,1,...,M 0071 

C 0072 

C SINTABU) 1 = 1. ..M+l CONTAINS SIN(J*PI/M) J=0,1,...,M 0073 

C 0074 
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C M MUST EXCEED ZERO 0075 

C 0076 

C JMIN MUST BE NON-NEGATIVE 0077 

C 0078 

C JMAX MUST EXCEED JMIN AND BE LSTHN= M 0079 

C 0080 

C SPACE(I) IS NOT USED IF M EXCEEDS N 0081 
C IS A BLOCK OF 2»M+4 TEMPORARIES IF M LSTHN= N 0082 

C ORDINARILY (SPACE NOT EQUIVALENT TO XCOR) THIS BLOCK 0083 

C CONSISTS OF SPACECI) I* 1 , 2» . . . , 2»M+4 0084 

C HOWEVER, IF SPACE AND XCOR ARE EQUIVALENT, THIS BLOCK 0085 

C CONSISTS OF SPACE(I) = XCOR(I) I=-M+l, ... ,M*4 0086 

C (NOTE THAT IF M«N, 3 REGISTERS BEYOND XC0R(N*1! 0087 

C ARE USED) 0088 

C 0089 
C OUTPUTS 0090 
C 0091 

C CSP(I) 1*1,2,... JMAX-JMIN+l CONTAINS CS(J) J=JMIN... JMAX AS 0092 
C DEFINED IN ABSTRACT. 0093 

C 0094 

C SSP(I) 1=1,2,... JMAX-JMIN+1 CONTAINS SS(J) J-JMIN... JMAX AS 0095 
C DEFINED IN ABSTRACT 0096 

C 0097 

C ERR * 0.0 NORMALLY 0098 

C « 1.0 IF N,M,JMIN OR JMAX IS ILLEGAL (PROGRAM EXITS 0099 

C WITHOUT COMPUTING SPECTRUM IN THIS CASE* 0100 

C 0101 
C EXAMPLES 0102 
C 0103 
C 1. COMPLETE SPECTRUM, NOT TRYING TO SAVE SPACE, M LSTHN N 0104 

C INPUTS - XCR(1.*.7) = -36. ,-27. ,-18. ,2. ,22. ,33. ,44. N*3 0105 

C C0STABI1...3) = l.,0.,-l. SINTABU...3) = 0.,I.,0. M*2 0106 

C JMIN=0 JMAX=M 0107 

C USAGE - CALL XSPECTUCR( 4) ,N, COSTAB, SINTAB, M*JMIftl, JMAX, 0108 

C CSP,SSP, SPACE, ERR) 0109 

C OUTPUTS - ERR=0. 0110 
C CSPtl.J.3) = 20. ,-4. ,-4. SSP(1.*.3) * 0.,~40.«0; 0111 

C 0112 
C 2. COMPLETE SPECTRUM SAVING SPACE 0113 

C INPUTS - SAME AS EXAMPLE 1. 0114 

C USAGE - CALL XSPECT ( XCR( 4 ) ,N,C0STAB,SINTA8,M* JMIN, JMAX, CSPi 0115 

C SSP,XCR(4),ERR) 0116 

C OUTPUTS - SAME AS EXAMPLE 1. (BUT XCRC2...9) WILL HAVE BEEN 0117 
C DEST POYED ) 0118 

C 0119 
C 3. PARTIAL SPECTRUM 0120 

C INPUTS - SAME AS EXAMPLE 1. EXCEPT JMIN=1 0121 

C USAGE - SAME AS EXAMPLE I. 0122 

C OUTPUTS - ERR-O* 0123 
C CSPU...2) = -4. ,-4. SSPU...2) = -40. ,0. 0124 

C 0125 
C 4. FINER GRAINED SPECTRUM, M GRTHN N 0126 

C INPUTS - SAME AS EXAMPLE 1. EXCEPT M=JMAX*4 AN© 0127 

C C0STABU...5) * 1., .70711,0. ,-.70711,-1. 0128 

C SINTABC 1...5) * 0., .70711,1., .70711,0. 0129 

C USAGE - SAME AS EXAMPLE 1. 0130 

C OUTPUTS - ERR^O. AND 0131 
C CSPU...5) = 20.,-. 82844, -4. ,4. 82844, -4. 0132 

C SSP(1.«.5) = 0., 144.85320,-40. ,24.85320,0. 0133 

C 0134 
C 5. ERROR EXITS WITH NO COMPUTATION 0135 

C USAGE - CALL XSPECT ( XCOR, -1,C0STA8, SINTAB, 3,0,3, 0136 

C CSP,SSP, SPACE, ERR1) 0137 

C CALL XSPECTUCOR, 2, COSTAB, SINTAB, 0,0*3, 0138 

C CSP,SSP, SPACE, ERR2) 0139 

C CALL XSPECTUCOR, 2, C0STA8, S INTAB , 3,- 1 , 3, 0140 

C CSP,SSP, SPACE, ERR3) 0141 

C CALL XSPECT ( XCOR, 2, COS TAB, S INTAB, 3,0*4, 0142 

C CSP, SSP, SPACE, ERR4) 0143 

C CALL XSPECTUCOR, 2, COSTAB, SINTAB, 3, 2, 2, 0144 

C CSP, SSP, SPACE, ERRS) 0145 

C OUTPUTS - ERRl^l. (ILLEGAL N) ERR2=1. (ILLEGAL M) 0146 

C ERR3- 1. (ILLEGAL JMIN) CRR4=l. (ILLEGAL JMAX) 0147 

C ERR5=1. (ILLEGAL JMAX) 0148 

C 0149 
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C PROGRAM FOLLOWS BELOW 0150 

C 0151 

C 0152 

C ARGUMENT DIMENSIONS 0153 

DIMENSION XCOR( 15000), COSTABt 15000), SINTAB( 15000) 0154 

DIMENSION CSP ( 15000) ,SSP( 15000), SPACE ( 15000) 0155 

C CHECK CONDITIONS ON N, JMIN, JMAX, M 0156 

MM=M 0157 

IF (N) 15,10,10 0158 

10 IF (JMIN) 15,12,12 0159 

12 IF (JMAX-JMIN) 15,15,14 0160 

14 IF ( JMAX-MM ) 17,17,15 0161 
C BAD 0162 

15 ERR=1.0 0163 
GO TO 99 0164 

C OK 0165 

17 ERR=0.0 0166 

C CHECK IF FOLDING ETC IS VALID (NOT IF M GREATER THAN N) 0167 

IF (MM-N) 30,3C,20 0168 

C NOTE, IN WHAT FOLLOWS WE OBTAIN EFFECTIVE NEGATIVE INDICES SINCE 0169 

C X(2) * X(2) 0170 

C X(l) = X(l) 0171 

C X(0) * X(32768) 0172 

C X(-l) ^ X(32768-l) 0173 

C ETC 0174 

C X(-J) * X(32768~J) 0175 

C FOLDING IS NOT POSSIBLE, COMPUTE SPECTRUM DIRECTLY AND EXIT 0176 

C 0177 

C FIRST SPLIT THE CORRELATION ON TOP OF ITSELF 0178 

20 JJ=32768-(N-1) 0179 

NN=2*N+l 0180 

CALL SPLIT (XCORCJJ) »NN, 1 .0,XCORI JJ ) ,XCORC 2 ) ) 0181 
C THEN FEED THE PARTS TO COSISP. (NOTE SHIFT OF ORIGIN FOR ANTISYM PART 0182 

C WHICH MAKES ITS FIRST ELEMENT NON-ZERO - BUT IT IS MULTIPLIED 0183 

C BY SIN(O).) 0184 

CALL COSISPCXCOR( JJ) ,XCORC JJ) ,XCGR,XCOR*N, C0STA8, SINTAB^MM, 0185 

1JMIN, JMAX, 1.0, CSP, SSP) 0186 

C THEN PUT THE CORRELATION BACK TOGETHER AND EXIT. 0187 

CALL REFIT (XCORC JJ) , NN, 1 .0 , XCORi JJ),XC0R(2) ) 0188 

GO TO 99 0189 

C FOLDING IS POSSIBLE. SETUP 0190 

30 LC0L=2*MM+1 0191 

LSYM=MM+ I 0192 

LSMSM=(MM+2)/2 0193 

C IS FOLDING TO TAKE PLACE ON TOP OF CORRELATION BLOCK 0194 

IF (XLOCF(SPACE HXLOCF(XCOR) ) 32,34,32 0195 

C NO, SET UP FOR THIS CASE 0196 

32 ISS=1 0197 

IAS=1+LSMSM 0198 

IMID=MM+1 0199 

ISA-MM+3 0200 

IAA=MM+3+LSMSM 0201 

IZER3=2*MM+4 0202 

GO TO 40 0203 

C YES, SET UP 0204 

34 I SS=32768-( MM-l) 0205 

IAS=32768-(MM-1)+LSMSM 0206 

IMID=l 0207 

ISA=3 0208 

I AA=3+LSMSM 0209 

IZER3=MM+4 0210 

GO TO 40 0211 

C THEN COLLAPSE THE CORRELATION INTO THE RANGE — M TO +M 0212 

C (IGNORE ERROR RETURN) 0213 

40 CALL KOLAPS(XCOR,N, 1.0, M, SPACE( IMID), DUMMY) 0214 

C THEN SPLIT THE COLLAPSED CORRELATION ON TOP OF ITSELF 0215 

CALL SPLIT( SPACE USS),LCOL, 1.0, SPACE( ISS),SPACE( IMI0+1)$ 0216 

C THEN SHIFT THE ANTISYMMETRIC PART UP TWO NOTCHES 0217 

C AND FILL IN THREE ZEROES 0218 

DO 45 1=1, MM 0219 

J=IMID+H-MM-I 0220 

45 SPACE ( J+2)=SPACE( J) 0221 

SPACE( IMID+1 )=0.0 0222 

SPACE ( IMID+2)=0.0 0223 

SPACE! IZER3)=0.0 0224 
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C NOW SPLIT THE SYMMETRIC PART ON TOP OF ITSELF 0225 

CALL 5PLIT(SPACE(ISS),LSYM,1.0,SPACE( ISS),SPACE( IAS*) 0226 

C THEN REVERSE SYMSYM # REVERSE AND CHANGE SIGNS OF ANTSYM 0227 

CALL CHPRTS(SPACE(ISS),SPACE( IAS),LSYM) 0228 

C NOW SPLIT THE ANTISYMMETRIC PART (EXTENOED) ON TOP OF ITSELf 0229 

CALL SPLIT(SPACEUSA) ,LSYM, 1.0, SPACE! I SA ) , SPACE ( I AA J ) 0230 

C THEN REVERSE SYMANT* REVERSE AND CHANGE SIGNS OF ANTANT 0231 

CALL CHPRTS(SPACE( ISA),SPACE( IAA),LSYM) 0232 

C FINALLY FEED THE FOUR PARTS TO COSISP AND THEN EXIT 0233 

LMONE-LSMSM-1 0234 

CALL COSISP (SPACE* ISS ) , SPACE ( I AS ) , SPACE( I SA ) f SP ACE ( i AA ) ^ 0235 

1LM0NE,C0STAB,SINTAB,MM, JMIN, JMAX, 1.0, CSP, SSP) 0236 

99 RETURN 0237 

END 0238 
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REFER TO 
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**#«*»#»«•»»•#**•#*»•»•* 

# XSQDEV * 
*«••»••#•••****•*****»*» 

REFER TO 
XSQDFR 



•*•*•*•*•****»»»**•***** 
* XSQDFR ♦ 
*»*»»••»•******»•*»#*»•* 



PROGRAM LISTINGS 



«*•**•**•*••**•**«»•*«•* 
» XSQDFR * 
**•*«**•*#»*•***««•••*•» 



* XSQDFR (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0112 
« FAP 0001 
♦XSQDFR 0002 

COUNT 100 0003 

LBL XSQDFR 0004 

ENTRY XSQDFR ( IX, IY, LXY, ISSXMY ) 0005 

ENTRY XSQDEV U X , I XB ASE , L I X, I SSXMB ) 0006 

* 0007 
« ABSTRACT 0008 

* 0009 

* TITLE - XSQDFR WITH SECONDARY ENTRY XSQDEV 0010 

* SUM SQUARE DIF. OF FXD. VECTOR FROM ANOTHER OR FROM A CONSTANT 0011 

* 0012 

* XSQDFR SUMS THE SQUARES OF THE DIFFERENCES BETWEEN THE 0013 

* ELEMENTS OF TWO FIXED ( FORTRAN-I I ) VECTORS 0014 

* 0015 

* XSQDEV SUMS THE SGUARES OF THE DIFFERENCES BETWEEN THE 0016 

* ELEMENTS CF A FIXED VECTOR AND A CONSTANT. 0017 

* 0018 

* LANGUAGE - FAP SUBROUTINES ( FORTRAN-I I COMPATIBLE) 0019 
» EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0020 
« STORAGE - 37 REGISTERS 0021 

* SPEED - 7090 709 0022 
» 38 + (28.6 OR 32.8)»LX MACHINE CYCLES »LX= VECTOR LENGTH 0023 
» AUTHOR - S.M. SIMPSON, AUGUST 1963 0024 

* 0025 

* USAGE 0026 

* 0027 

* TRANSFER VECTOR CONTAINS ROUTINES - (NONE) 0028 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0029 

* 0030 

* FORTRAN USAGE 0031 
» CALL XSQDFR(IX,IY,LXY,ISSXMY) 0032 

* CALL XSQDEV( IX, I XBASE, L IX, ISSXMB) 0033 

* 0034 

* INPUTS 0035 

* 0036 
« I X ( I ) 1 = 1... LXY ARE FORTRAN- 1 1 INTEGERS, INPUT TO XSQDFR 0037 

* IYU) 1 = 1. ..LXY ARE FORTRAN— 1 1 INTEGERS, INPUT TO XSQDFR 0038 

* LXY SHOULD EXCEED 0 0039 

* 0040 

* IX(I) 1=1. ..LIX ARE FORTRAN- I I INTEGERS INPUT TO XSQDEV 0041 

* IXBASE IS A FORTRAN- 1 1 INTEGER INPUT TO XSQDEV 0042 

* LIX SHOULD EXCEED 0 0043 

* 0044 
« OUTPUTS STRAIGHT RETURN WITH NO ACTION IF LXY OR LIX LSTHN 1 0045 

* 0046 

* ISSXMY IS SUMIFROM 1=1 TO LXY) OF \ I X I I)-IYII))*( IX( O-IY(Il) 0047 

* 0048 

* ISSXMB IS SUMtFROM 1 = 1 TO LIX) OF ( IX( I)-IXBASE)*(IX( D- 1 XBASE) 0049 
» 0050 

* DANGER OF OVERFLOW, NOT TESTED FOR BY EITHER ENTRY. 0051 

* 0052 
» EQUIVALENCE* ISSXMY, ANY INPUT ) , ( I SSXMB, ANY INPUT) 0053 
« IS PERMITTED. 0054 

* 0055 

* EXAMPLES 0056 

* 0057 

* 1. INPUTS - IXC1...3) = 1, 2, 3 IY<1.,.3)= 3, 4, 5 ISDIF2*0 0058 

* USAGE - CALL XSQDFR( IX, IY,3, ISDIF1 ) 0059 

* CALL XSQDEVUX, 3,3,ISDEV1) 0060 

* CALL XSQDFR( IX,IY,l,IX) 0061 

* CALL XSQDFR ( IX,IY,0,ISDIF2) 0062 

* OUTPUTS - ISDIFl = 12, ISDEV1 = 5, IX(1)= 4,ISDIF2 = 0 (NO OUTPUT) 0063 

* 0064 

* PROGRAM FOLLOWS BELOW 0065 
» 0066 

* 0067 

* NO TRANSFER VECTOR 0068 

HTR 0 XR4 0069 

BCI 1, XSQDFR 0070 

* PRINCIPAL ENTRY. XSQDFR ( IX, IY, LXY, ISSXMY ) 0071 
XSQDFR CLA 2,4 0072 

ADD Kl A(IY)+1 0073 

STA 'SUB 0074 



••*••*•»•*»•**•»•••••*** PROGRAM LISTINGS #**#*»**»•*#»#*•*•*»♦*»# 

* XSQDFR * # XSQDFR * 

•»»«•**•*******•••»*•*#* ##♦*#****»*»*» 
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CLA 


SUB 






0075 


SETUP 


STO 


SUBTR 






0076 




SXD 


XSQDFR-2,4 






0077 


Kl 


CLA 


lt4 






0078 




ADO 


Kl 


A( IXJ + l 




0079 




ST A 


GET 






0080 




CLA* 


3,4 


LXY 




0081 




TMI 


LEAVE 






0082 




PDX 


0,4 






0083 




TXL 


LEAVE, 4,0 






0084 




STZ 


TEMPI 






0085 


» LOOP 










0086 


GET 


CLA 


**,4 


**«A( IX)+1 




0087 


SUBTR 


SUB 


** 9 ** 


=SUB AUY> + 1,4 


OR SUB Al IXBASE) 


0088 




STO 


TEMP2 






0089 




XCA 








0090 




MPY 


TEMP2 






0091 




ALS 


17 






0092 




ADD 


TEMPI 






0093 




STO 


TEMPI 






0094 




TIX 


GET, 4,1 






0095 


* STORE RESULT 








0096 




LXO 


XSQDFR-2,4 






0097 




STO* 


4,4 






0098 


• EXIT 










0099 


LEAVE 


LXD 


XSQDFR-2,4 






0100 




TRA 


5,4 






0101 


» SECOND ENTRY, XSQDEVUX, 


IXBASE,LIX, ISSXMB) 




0102 


XSQDEV 


CLA 


2,4 


A( IXBASE) 




0103 




STA 


SUBXB 






0104 




CLA 


SUBXB 






0105 




TRA 


SETUP 






0106 


* CONSTANTS, TEMPORARIES 






0107 


SUB 


SUB 


**,4 


**=A{ IY)+1 




0108 


SUBXB 


SUB 


*» 


**=A( IXBASE) 




0109 


TEMPI 


PZE 


**,*», #« 


SUM 




0110 


TEMP2 


PZE 


*« 9 »*, #* 


DIFFERENCES 




0111 




END 








0112 



•****•••******»*•*****«» PROGRAM LISTINGS ***#*#*#####»#«**#»»»»»# 

* XSQRUT * ♦ XSQRUT » 

*****••»*»»•»**»***••••* **4*«* ••*•**## •**•»•#*«* 



XSQRUT (SUBROUTINE) 
FAP 



9/29/64 LAST CARD IN DECK IS NO* 



»XSQRUT 



COUNT 100 
L8L XSQRUT 

ENTRY XSQRUT U X, LIX , IXSQRT ) 

• 

* ABSTRACT 

* 

* TITLE - XSQRUT 

» SQUARE ROOT OF A FIXED VECTOR WITH ROUNDING 

* 

* XSQRUT FORMS A FIXED VECTOR WHOSE ELEMENTS ARE THE 

* SQUARE ROOTS {ROUNDED TO FORTRAN— 1 1 INTEGERS) OF ANOTHER 

* FIXED VECTOR (ALSO FORT RAN- 1 1 INTEGERS). OUTPUT MAY 

* REPLACE INPUT. 
* 

* LANGUAGE - FAP SUBROUTINE i FORTRAN— 1 1 COMPATIBLE) 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 

* STORAGE - 37 REGISTERS 

» SPEED - ABOUT 78 ♦ 250*LX MACHINE CYCLES, LX = VECTOR LENGTH 

» AUTHOR - S.M. SIMPSON, AUGUST 1963 

* 

* USAGE 

* 

* TRANSFER VECTOR CONTAINS ROUTINES - FIXVR 

* AND FORTRAN SYSTEM ROUTINES - SQRT (FUNCTION) 
* 

* FORTRAN USAGE 

* CALL XSQRUT (?IX, LIX, IXSQRT ) 
* 

* INPUTS 
* 

* IXCI) 

» LIX 
* 

» OUTPUTS 



1 = 1. ..LIX IS A NON-NEGATIVE FORTRAN— 1 1 INTEGER VECTOR 
SHOULD EXCEED 0 

STRAIGHT RETURN WITH NO OUTPUT IF LIX LSTHN 1 



IXSQRTCI) 1 = 1.. .LIX IS IXSQRT(I) = XF IXRF( SQRTF( FLOATFUXt I J) 1) 
WHERE XFIXRF IMPLIES FIXING WITH ROUNDING. NEGATIVE 
VALUES OF IXC I) ARE TREATED AS THOUGH THEY WERE 
POSITIVE. 



* EXAMPLES 

* 1. INPUTS 
» 

* USAGE 
* 

* OUTPUTS 



EQUIVALENCE (IXSQRT, IX) IS PERMITTED. 



- IXU...5) = 1,2,3,4,5 IYU...5) = 100,-200,300,-400,500 

I SQRT3 = 0 

CALL XSQRUT( IX, 5, ISQRT1) 
CALL XSQRUT (IY, 5, I SQRT 2) 
CALL XSQRUT( IY,i,IY) 
CALL XSQRUT ( IX, 0, ISQRT3) 

- ISQRTK1...5) = 1,1,2,2,2 
ISQRT2( 1...5) = 10,14,17,20,22 

IYU) « 10 ISQRT3 * 0 (NO OUTPUT CASE) 



* PROGRAM FOLLOWS BELOW 



0102 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
002 3 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 



« 






0059 


• 






0060 


» TRANSFER 


VECTOR CONTAINS SQRT, FIXVR 


0061 




HTR 


0 XR1 


0062 




HTR 


0 XR4 


0063 




BCI 


1, XSQRUT 


0064 


* ONLY 


ENTRY. XSCRUT ( I X , L I X , I XSQRT ) 


0065 


XSQRUT 


SXD 


XSQRUT-3,1 


0066 




SXD 


XSQRUT-2,4 


0067 


Kl 


CLA 


1,4 


0068 




ADD 


Kl A(IX)+1 


0069 




STA 


GET 


0070 




CLA 


3,4 A(IXSQRT) 


0071 




STA 


TSXl 


0072 




STA 


TSX3 


0073 




ADD 


Kl AUXSQRTm 


0074 



•»*»•••••«»*••»****«***• PROGRAM LISTINGS **#»«*»*»»«***»**#*♦#*** 

» XSQRUT * # XSQRUT * 

**«•»••••••»»*•*•*»***#* #*##»#*• •*##*-# ****•••»** 
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STA 


STORE 




0075 




CLA 


2,4 


A(LIX) 


0076 




STA 


TSX2 




0077 




CLA* 


2,4 


LIX 


0078 




TMI 


LEAVE 




0079 




PDX 


0,1 




0080 




TXL 


LEAVE ,1,0 




0081 


* LOOP 








0082 


GET 


CLA 


**, 1 


**=A( IX)+1 


0083 




LRS 


18 




0084 




ORA 


OCTK 




0085 




FAO 


OCTK 




0086 




SSP 






0087 




TSX 


$SQRT,4 




0088 


STORE 


STO 


**»1 


**=A( IXSQRT)+1 


0089 




TIX 


GET, 1,1 




0090 


* THEN 


EIX 


WITH ROUNDING 




0091 




TSX 


$FIXVR,4 




0092 


TSXl 


TSX 


**,0 


**=A( IXSQRT) 


0093 


TSX2 


TSX 


**,0 


**=A(LIX) 


0094 


TSX3 


TSX 


**,0 


***A( IXSQRT) 


0095 


« EXIT 








0096 


LEAVE 


LXD 


XSQRUT-2,4 




0097 




LXD 


XSQRUT-3, I 




0098 




TRA 


4,4 




0099 


* CONSTANTS 






0100 


OCTK 


OCT 


233000000000 




0101 




END 






0102 



*****•»««*•***•**•*«**•* 

* XSQSUM * 
»**#»••»*»****»*#.*»»«»## 

REFER TO 

SQRSUM 



PROGRAM LISTINGS 



«•*•«•***«**•****••**•*« 

* XSQSUM * 
t *#«***• •*«•*•«•* #***##• 

REFER TO 

SQRSUM 



•»•*•***«*•***»•*•*•»*«• 

* XSQUAR * 
•»•**«•*«*•****•**•»«»#» 

REFER TO 
SQUARE 



***•*»•**«•#•««*••**•••» 

* XSQUAR * 
**##*#•• ****»***»••***«• 

REFER TO 

SQUARE 



*»»•*»•***»•*»*••»««»**• 

* XSTEPC * 
**»••»••**•*****»**••*** 

REFER TO 
DELTA 



#»*♦••»»»•**•#•••«***»•» 

* XSTEPC * 
**»***»**«***»***#*•**«» 

REFER TO 
DELTA 



* XSTEPL * 
•»••*••*«•*»»*•*****••»* 

REFER TO 
DELTA 



**•****#**•*»•*****•*»*» 

* XSTEPL » 
*#*»#♦*«»##*♦*#♦♦**»*»** 

REFER TO 
DELTA 



••«**•*»**•*»****»*«••** 

• XSTEPR « 
»»**»•••*««•**«•»«*•»•»• 

REFER TO 
DELTA 



***•*#**#*•#«•***»***#** 

* XSTEPR » 
•»••*•»»*«•»»*•*#*•»*»»« 

REFER TO 
DELTA 



*•••*•••••«*•«**«*•*•»** PROGRAM 
* XSTLIN * 
•*•••*«**••«*******•**•* 

REFER TO 

SETLIN 



LISTINGS 0 •««••*» 

* XSTLIN * 
**•**#•• •*••*****• 

REFER TO 

SETLIN 



*•»**•»»•»••*•»•**•»**•* 
* XSUBK * 
»•*••«*»»****»»*•••»•*•* 



REFER TO 
AOOK 



••»***•«••«***»»*»•«*»»» 

» XSUBK « 



REFER TO 
AODK 



**»*••**•*»*»•***»•*•«« 

* XSUBKS 



REFER TO 
AODK 



#»**♦#####»*****#**»•»** 

* XSUBKS » 
*•*»*•**•*»**•**»*•»••»• 

REFER TO 
AODK 



*»»«#•*••*»•***•»*»•**#* 

» XSUM » 
»»*»#»*••«#♦***»♦***»##» 

REFER TO 
SUM 



*•«#*••«•«*•*•*«**«*•*** 

* XSUM * 

l«# *•#**»***»«*** ««**»** 

REFER TO 
SUM 



«*»*•••«»•••«*•********* 

♦ XVDRBV * 
»**••**•»»»•*»*«******«• 

REFER TO 

XVDVBV 



«•*«••***•**•***•»»•«»** 

* XVORBV * 
«****•***«••«#••**»**«»* 

REFER TO 
XVDVBV 



»#»*»*•♦#«♦*# *»**#»#»♦## 
* XVDVBV » 
••••**••**••*••»•*****•« 



PROGRAM LISTINGS 



#»«•»#»*•««**#•*•*»•*•** 

# XVDVBV » 



» XVDVBV (SUBROUTINE) 9/29/64 LAST CARD IN DECK IS NO. 0108 

* FAP 0001 
•XVDVBV 0002 

COUNT 100 0003 

LBL XVDVBV 0004 

ENTRY XVDVBV (*I X, IY,LXY, IXDVBY) 0005 

ENTRY XVDRBV { I X, IY, LXY, IXDVBY ) 0006 

» 0007 

* + ABSTRACT—— 0008 

* 0009 

* TITLE - XVDVBV WITH SECONDARY ENTRY XVDRBV 0010 

* DIVIDE ELEMENTS OF TWO FIXED VECTORS WITH OR WITHOUT ROUNDING 0011 

* 0012 
» XVDVBV DIVIDES THE ELEMENTS OF ONE FIXED VECTOR BY THOSE 0013 
» OF ANOTHER, TRUNCATING FRACTIONAL PARTS. 0014 

* XVDRBV ROUNDS FRACTIONAL PARTS. 0015 

* 0016 
» OUTPUT MAY REPLACE EITHER INPUT VECTOR. 0017 
» 0018 

* LANGUAGE - FAP SUBROUTINES I FORTRAN— 1 1 COMPATIBLE) 0019 

* EQUIPMENT - 709 OR 7090 (MAIN FRAME ONLY) 0020 
» STORAGE - 34 REGISTERS 0021 

* SPEED - 7090 709 0022 

* XVDVBV 41 + (49 OR 56)*LXY MACHINE CYCLES* 0023 

* XVDRBV 43 ♦ (51 OR 58)*LXY LXY » VECTOR LENGTH 0024 

* AUTHOR - S.M. SIMPSON, AUGUST 1963 0025 

* 0026 

* * USAGE >- 0027 

* 0028 
» TRANSFER VECTOR CONTAINS ROUTINES - XDIVt XDIVR 0029 

* AND FORTRAN SYSTEM ROUTINES - (NONE) 0030 
» „ 0031 

* FORTRAN USAGE 0032 
» CALL XVDVBV ( IX, I Y, LXY, IXDVBY) 0033 

* CALL XVDRBV( IX, IY, LXY, IXDVBY) 0034 

* 0035 
» INPUTS 0036 

* 0037 

* IXU) 1 = 1. ..LXY IS A FORTRAN— 1 1 INTEGER VECTOR 0038 

* 0039 
« IY(I) 1*1.. .LXY IS A FORTRAN—I I INTEGER VECTOR, NONI OF WHICH 0040 
» =0 0041 
» 0042 
» LXY SHOULD EXCEED 0 0043 

* 0044 
» OUTPUTS STRAIGHT RETURN WITH NO OUTPUTS IF LXY LSTHN 1 0045 

* 0046 

* IXDVBYU) I = l.i. LXY IS IXOVBY(I) * IX(I)/IY(I) , 0047 

* TRUNCATED IF XVDVBV IS USED, 0048 

* ROUNDED IF XVDRBV IS USED. 0049 
» 0050 
» DIVISIONS ARE PERFORMED BY XDIV AND XDIVR FUNCTIONS IN 0051 
» WHICH DIVISION BY ZERO GIVES RESULT EQUAL TO NUMERATOR 0052 
» AND THE DIVIDE CHECK INDICATOR IS NOT TURNED ON. 0053 

* 0054 

* EQUIVALENCE (IXDVBY, IX OR IY) IS PERMITTED. 0055 

* 0056 

* EXAMPLES 0057 
» 0058 
» 1. INPUTS - IXIU..5) « 1,2,3,4,5 IYU...5) « 4,4,4,4#4 fZ*0 0059 

* USAGE - CALL XVDVBVt IX, IY,5, IQ1I 0060 
» CALL XVDRBV( IX,IY,5,IQ2) 0061 
» CALL XVDVBV(IX,IY,1,IY) 0062 

* CALL XVDVBV( IX,IY,-1,IZ) 0063 

* OUTPUTS - IQK1...5) » 0,0,0,1,1 IQ2(1..*5) = 0,1,W1,1 0064 
» IY(l) =0 IZ * 0 (NO OUTPUT CASE) 0065 

* 0066 

* PROGRAM FOLLOWS BELOW 0067 
» 0068 
» 0069 

* TRANSFER VECTOR CONTAINS XDIV AND XDIVR FUNCTIONS 0070 

HTR 0 XR1 0071 

HTR 0 XR4 0072 

BCI 1, XVDVBV 0073 

» PRINCIPAL ENTRY. XVDVBV( IX, IY, LXY, IXDVBY ) 0074 



**•«••*•«»••»*»•»«••*««• PROGRAM LISTINGS «»»#«•*»♦*»**#•»**»#*»»* 

« XVDVBV * * XVDV8V * 

••#*»•••»»•»**»*«••••*#* #»#*♦#•*»»##»#***»*»»♦♦* 
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XVDVBV 


CLA 


DIV 




0075 


SETUP 


STO 


VARY 




0076 




SXD 


XVDVBV-3, 1 




0077 




SXD 


XVDVBV-2,4 




0078 


Kl 


CLA 


1,4 




0079 




ADD 


Kl 


A< IX )+l 


0080 




STA 


GETN 




0081 




CLA 


2,4 




0082 




ADD 


Kl 


A( IY)+1 


0083 




STA 


GETD 




0084 




CLA 


4,4 




0085 




ADD 


Kl 


**=A( IX0VBY)+1 


0086 




STA 


STORE 




0087 




CLA» 


3,4 


LXY 


0088 




TMI 


LEAVE 




0089 




PDX 


0,1 




0090 




TXL 


LEAVE ,1,0 




0091 


» DIVISION 


LOOP 




0092 


GETN 


CLA 


**t 1 


«*=A( IX)+1 


0093 


GETD 


LDQ 


**.l 


**=A( IY)+1 


0094 


VARY 


TSX 


** ,4 


**=$XDIV OR $XDIVR 


0095 


STORE 


STO 


♦♦♦1 


♦*=A( IXDVBY)+1 


0096 




TIX 


GETN, 1,1 




0097 


» EIXT 








0098 


LEAVE 


LXD 


XVDVBV-3,1 




0099 




LXD 


XVDVBV-2,4 




0100 




TRA 


5,4 




0101 


* SECOND ENTRY. XVDRBVUX, 


IY,LXY, IXDVBY) 


0102 


XVDRBV 


CLA 


DIVR 




0103 




TRA 


SETUP 




0104 


* CONSTANTS 






0105 


DIV 


TSX 


$XDIV,4 




0106 


DIVR 


TSX 


$XDIVR #4 




0107 




END 






0108 



•*••**#*# *#•***»**♦»**#* 
» XVMNSV * 
***«»**••*»*•»***••***** 

REFER TO 

VPLUSV 



PROGRAM LISTINGS 



#••******»*•*#«»«««***«* 

* XVMNSV * 
**#•*•**«»*••*«•«*«****» 

REFER TO 
VPLUSV 



*»•••»••#*•«*•••**«**»#* 
* XVPLSV * 
*♦*»#»»»*♦»*»»**»******* 

REFER TO 

VPLUSV 



*»*«*•** »**•*#«* ****•»•* 

* XVPLSV * 
#*##*♦#«»♦»*♦##***»*»*** 

REFER TO 

VPLUSV 



»»•*•»•«****»•*****•»*** 
» XVTMSV * 
»****••••••***••••»***#* 

REFER TO 

VTIMSV 



#»****♦*•#***#*•*««**»** 

♦ XVTMSV * 
****#«•«•• ««»f*ft» *«»**#* 

REFER TO 

VTIMSV 



•**»*••»*••«**»***•»**#• 

* XWHICH * 
•*•*••*«*#***•«»•*•*•*«* 

REFER TO 
WHICH 



«•***•*•*«•**«***«***••» 

* XWHICH * 
**#•*••**•*»*•****»*••*# 

REFER TO 
WHICH 



•••«•«**«•••*»••••*••••• PROGRAM LISTINGS »••#•»•*•*•»•»»»»*»»»»»» 

• ZEFBCD • ♦ ZEFBCD * 

••••••»•»»*••#«*«•»**••• ••••*•*•*»•*****••«••«•» 

« ZEFBCD CFUNCTIONI 9/8/64 LAST CARD IN OECK IS NO. 0128 

» FAP 0001 

•ZEFBCD 0002 

COUNT 100 0003 

LBL ZEFBCD 0004 

ENTRY ZEFBCD F(ITAPE) 0005 

ENTRY ZEFBIN FUTAPE) 0006 

• 0007 

• 0008 
» ABSTRACT 0009 

• 0010 
» TITLE - ZEFBCD WITH SECONDARY ENTRY ZEFBIN 0011 
« TEST IF NEXT TAPE RECORD IS END OF FILE AND REPOSITION TAPE 0012 

• 0013 

• ZEFBCD READS ONE BCD RECORD ANO CHECKS TO SEE IF THAT 0014 

• RECORD WAS AN END OF FILE. IT BACKSPACES OVER THE RECORD 0015 

• BEFORE RETURNING. A REDUNDANCY INDICATION IS PROVIDED. 0016 
« 0017 
« ZEFBIN DOES THE SAME THING FOR A BINARY TAPE. 0018 
« 0019 
« 0020 

• LANGUAGE - FAP SUBROUTINE 0021 
« EQUIPMENT - 709 OR 7090 (MAIN FRAME AND TAPE DRIVE) 0022 
« STORAGE - 54 REGISTERS 0023 

• SPEED - 0024 
« AUTHOR - J.N. GALBRAITH, JR. 0025 

• 0026 

• 0027 

« USAGE 0028 

« 0029 

« TRANSFER VECTOR CONTAINS ROUTINES - NONE 0030 

• AND FORTRAN SYSTEM ROUTINES - ( IOS) , (RDS ) , (RCH) , <TCO) , (TRC) » 0031 

• (TEF) f (BSR) 0032 

• 0033 
« FORTRAN USAGE 0034 

• ENDF IL^ZEFBCDF ( ITAPE) 0035 

• ENDFIL=ZEFBINFC ITAPE) 0036 
» 0037 

• 0038 

• INPUTS 0039 

• 0040 

• ! TAPE LOGICAL TAPE NUMBER TO BE CHECKED. 0041 

• 0042 
« 0043 
« OUTPUTS 0044 

• 0045 

• ENDFIL FLOATING POINT INDICATOR. 0046 

• * 0. IF END OF FILE 0047 
« * 1. IF NO END OF FILE 0048 

• =-l. IF REDUNDANCY FOUND (READ TEN TIMES). 0049 

• A REDUNDANCY WILL NOT BE SIGNALLED IF BOTH THE 0050 

• REDUNDANCY INDICATOR AND END OF FILE INDICATOR ARE 0051 

• TURNED ON, BUT THE END OF FILE WILL BE SIGNALLED. 0052 

• 0053 

• 0054 

• EXAMPLE 0055 

• 0056 
» 1. USAGE - ITP = 9 0057 
» REWIND ITP 0058 
» A = 6HCARD 1 0059 

• WRITE OUTPUT TAPE ITP, 10, A 0060 
« 10 FORMAT ( A6) 0061 

• END FILE ITP 0062 

• REWIND ITP 0063 

• ENDFL1 * ZEFBCDF ( I TP ) 0064 

• ENDFL2 » ZEFBINF ( I TP ) 0065 

• READ INPUT TAPE ITP, 10, A 0066 
» EN0FL3 * ZEFBCDF ( ITP ) 0067 
« ENDFL4 * ZEFBINF ( I TP ) 0068 
» REWIND ITP 0069 

• WRITE TAPE ITP, A 0070 
» END FILE ITP 0071 

• REWIND ITP 0072 

• ENDFL5 = ZEFBINF (ITP ) 0073 
« ENDFL6 = ZEFBCDF(ITP) 0074 



* ZEFBCD 
(PAGE 2) 



PROGRAM LISTINGS 



ZEFBCD 



{ PAGE 2) 



* OUTPUTS 










0075 


• OUTPUTS 


• ENDFL1...6 - 








0076 


• 












0077 


• 












0078 


* PROGRAM FOLLOWS BELOW 








0079 


• 












0080 




PZE 










0081 




BCI 


It ZEFBCD 








0082 


ZEFBIN 


SSP 










0083 




ADD 


BINARY 


SET FOR BINARY 


MODE 


0084 


ZEFBCD 


SSP 










0085 




STO 


TAPE 








0086 




SXA 


RETURN? 1 








0087 




SXA 


RETURN+1,2 








0088 




SXD 


ZEFBIN-2,4 








0089 




CAL 


TAPE 








0090 




TSX 


$(I0S>,4 








0091 




AXT 


1,1 








0092 


READ 


XEC* 


$(RDS) 








0093 




LDQ* 


$<RCH) 








0094 




SLQ 


*+l 








0095 




RCHA 


10 








0096 




LDQ* 


$(TCO) 








0097 




SLQ 


TCO 








0098 




LDQ* 


$(TEF) 








0099 




SLQ 


TEF 








0100 




LDQ* 


$(TRC) 








0101 




SLQ 


TRC 








0102 




SLQ 


SETOFF 








0103 


TCO 


TCOA 


• 








0104 


TFF 


TEFA 


ENDFIL 








0105 


TRC 


TRCA 


REDUND 








0106 




XEC* 


S(BSR) 








0107 




CLA 


ONE 








0108 


RETURN 


AXT 


**tl 








0109 




AXT 


**.2 








0110 




LXD 


ZEFBIN-2,4 








0111 


SETOFF 


TRCA 


*+l 








0112 




TRA 


1»4 








0113 


ENDFIL 


XEC* 


$(BSR) 








0114 




CLA 


ZERO 








0115 




TRA 


RETURN 








0116 


REDUNO 


XEC* 


S(BSR) 








0117 




TXI 


•+lf ltl 








0118 




TXL 


READ, 1,10 








0119 




CLS 


ONE 








0120 




TRA 


RETURN 








0121 


ZERO 


PZE 


0 








0122 


ONE 


DEC 


1. 








0123 


TAPE 


PZE 










0124 


BINARY 


PZE 


16 








0125 


10 


IOCD 


DUMMY, 0,1 








0126 


CUMMY 


PZE 










0127 




END 










0128 



* ZEFBIN » 
***•«*»**••••»«»*»•**•»» 

REFER TO 
ZEFBCO 



PROGRAM LISTINGS ••••»••*•••••»*••••»•••• 

* ZEFBIN • 



REFER TO 
ZEFBCD 



